Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Merge tip-548 |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | cplusplus |
Files: | files | file ages | folders |
SHA3-256: |
fb24db99f5e1b06a6c4df40ea097e2cc |
User & Date: | jan.nijtmans 2019-08-15 15:20:29.679 |
Context
2019-08-29
| ||
13:28 | Merge tip-548 check-in: c933888049 user: jan.nijtmans tags: cplusplus | |
2019-08-15
| ||
15:20 | Merge tip-548 check-in: fb24db99f5 user: jan.nijtmans tags: cplusplus | |
08:59 | Merge 8.7 check-in: 42a10393d8 user: jan.nijtmans tags: tip-548 | |
2019-08-11
| ||
21:33 | Merge tip-548 check-in: 4c438921db user: jan.nijtmans tags: cplusplus | |
Changes
Changes to compat/fake-rfc2553.c.
︙ | ︙ | |||
69 70 71 72 73 74 75 76 77 78 79 80 81 82 | int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host, size_t hostlen, char *serv, size_t servlen, int flags) { struct sockaddr_in *sin = (struct sockaddr_in *)sa; struct hostent *hp; char tmpserv[16]; if (sa->sa_family != AF_UNSPEC && sa->sa_family != AF_INET) return (EAI_FAMILY); if (serv != NULL) { snprintf(tmpserv, sizeof(tmpserv), "%d", ntohs(sin->sin_port)); if (strlcpy(serv, tmpserv, servlen) >= servlen) return (EAI_MEMORY); | > | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host, size_t hostlen, char *serv, size_t servlen, int flags) { struct sockaddr_in *sin = (struct sockaddr_in *)sa; struct hostent *hp; char tmpserv[16]; (void)salen; if (sa->sa_family != AF_UNSPEC && sa->sa_family != AF_INET) return (EAI_FAMILY); if (serv != NULL) { snprintf(tmpserv, sizeof(tmpserv), "%d", ntohs(sin->sin_port)); if (strlcpy(serv, tmpserv, servlen) >= servlen) return (EAI_MEMORY); |
︙ | ︙ | |||
149 150 151 152 153 154 155 | #ifndef HAVE_GETADDRINFO static struct addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints) { struct addrinfo *ai; | | | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 | #ifndef HAVE_GETADDRINFO static struct addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints) { struct addrinfo *ai; ai = (struct addrinfo *)malloc(sizeof(*ai) + sizeof(struct sockaddr_in)); if (ai == NULL) return (NULL); memset(ai, '\0', sizeof(*ai) + sizeof(struct sockaddr_in)); ai->ai_addr = (struct sockaddr *)(ai + 1); /* XXX -- ssh doesn't use sa_len */ |
︙ | ︙ |
Changes to compat/gettod.c.
︙ | ︙ | |||
17 18 19 20 21 22 23 24 25 26 27 28 29 30 | int gettimeofday( struct timeval *tp, struct timezone *tz) { struct timeb t; ftime(&t); tp->tv_sec = t.time; tp->tv_usec = t. millitm * 1000; return 0; } | > | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | int gettimeofday( struct timeval *tp, struct timezone *tz) { struct timeb t; (void)tz; ftime(&t); tp->tv_sec = t.time; tp->tv_usec = t. millitm * 1000; return 0; } |
Changes to compat/mkstemp.c.
︙ | ︙ | |||
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <errno.h> #include <fcntl.h> #include <stdlib.h> #include <unistd.h> /* *---------------------------------------------------------------------- * * mkstemp -- * * Create an open temporary file from a template. * * Results: * A file descriptor, or -1 (with errno set) in the case of an error. * * Side effects: * The template is updated to contain the real filename. * *---------------------------------------------------------------------- */ int mkstemp( | > | | | | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <errno.h> #include <fcntl.h> #include <stdlib.h> #include <unistd.h> #include <string.h> /* *---------------------------------------------------------------------- * * mkstemp -- * * Create an open temporary file from a template. * * Results: * A file descriptor, or -1 (with errno set) in the case of an error. * * Side effects: * The template is updated to contain the real filename. * *---------------------------------------------------------------------- */ int mkstemp( char *tmpl) /* Template for filename. */ { static const char alphanumerics[] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; char *a, *b; int fd, count, alphanumericsLen = strlen(alphanumerics); /* == 62 */ a = tmpl + strlen(tmpl); while (a > tmpl && *(a-1) == 'X') { a--; } if (a == tmpl) { errno = ENOENT; return -1; } /* * We'll only try up to 10 times; after that, we're suffering from enemy * action and should let the caller know. |
︙ | ︙ | |||
67 68 69 70 71 72 73 | *b = alphanumerics[(int)(r * alphanumericsLen)]; } /* * Template is now realized; try to open (with correct options). */ | | | 68 69 70 71 72 73 74 75 76 77 78 79 | *b = alphanumerics[(int)(r * alphanumericsLen)]; } /* * Template is now realized; try to open (with correct options). */ fd = open(tmpl, O_RDWR|O_CREAT|O_EXCL, 0600); } while (fd == -1 && errno == EEXIST && --count > 0); return fd; } |
Changes to compat/opendir.c.
︙ | ︙ | |||
16 17 18 19 20 21 22 | * open a directory. */ DIR * opendir( char *name) { | | | | | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | * open a directory. */ DIR * opendir( char *name) { DIR *dirp; int fd; const char *myname; myname = ((*name == '\0') ? "." : name); if ((fd = open(myname, 0, 0)) == -1) { return NULL; } dirp = (DIR *) ckalloc(sizeof(DIR)); if (dirp == NULL) { |
︙ | ︙ | |||
61 62 63 64 65 66 67 | /* * get next entry in a directory. */ struct dirent * readdir( | | | | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | /* * get next entry in a directory. */ struct dirent * readdir( DIR *dirp) { struct olddirect *dp; static struct dirent dir; for (;;) { if (dirp->dd_loc == 0) { dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ); if (dirp->dd_size <= 0) { return NULL; |
︙ | ︙ | |||
97 98 99 100 101 102 103 | /* * close a directory. */ void closedir( | | | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | /* * close a directory. */ void closedir( DIR *dirp) { close(dirp->dd_fd); dirp->dd_fd = -1; dirp->dd_loc = 0; ckfree(dirp); } |
Changes to compat/strstr.c.
︙ | ︙ | |||
32 33 34 35 36 37 38 | * None. * *---------------------------------------------------------------------- */ char * strstr( | | | | 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | * None. * *---------------------------------------------------------------------- */ char * strstr( char *string, /* String to search. */ char *substring) /* Substring to try to find in string. */ { char *a, *b; /* * First scan quickly through the two strings looking for a * single-character match. When it's found, then compare the rest of the * substring. */ |
︙ | ︙ |
Changes to compat/strtol.c.
︙ | ︙ | |||
41 42 43 44 45 46 47 | * character, or NULL. */ int base) /* Base for conversion. Must be less than 37. * If 0, then the base is chosen from the * leading characters of string: "0x" means * hex, "0" means octal, anything else means * decimal. */ { | | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | * character, or NULL. */ int base) /* Base for conversion. Must be less than 37. * If 0, then the base is chosen from the * leading characters of string: "0x" means * hex, "0" means octal, anything else means * decimal. */ { const char *p; long result; /* * Skip any leading blanks. */ p = string; |
︙ | ︙ |
Changes to compat/strtoul.c.
︙ | ︙ | |||
58 59 60 61 62 63 64 | * character, or NULL. */ int base) /* Base for conversion. Must be less than 37. * If 0, then the base is chosen from the * leading characters of string: "0x" means * hex, "0" means octal, anything else means * decimal. */ { | | | | | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | * character, or NULL. */ int base) /* Base for conversion. Must be less than 37. * If 0, then the base is chosen from the * leading characters of string: "0x" means * hex, "0" means octal, anything else means * decimal. */ { const char *p; unsigned long int result = 0; unsigned digit; int anyDigits = 0; int negative=0; int overflow=0; /* * Skip any leading blanks. */ |
︙ | ︙ |
Changes to compat/waitpid.c.
︙ | ︙ | |||
66 67 68 69 70 71 72 | pid_t pid, /* The pid to wait on. Must be -1 or greater * than zero. */ int *statusPtr, /* Where to store wait status for the * process. */ int options) /* OR'ed combination of WNOHANG and * WUNTRACED. */ { | | | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | pid_t pid, /* The pid to wait on. Must be -1 or greater * than zero. */ int *statusPtr, /* Where to store wait status for the * process. */ int options) /* OR'ed combination of WNOHANG and * WUNTRACED. */ { WaitInfo *waitPtr, *prevPtr; pid_t result; WAIT_STATUS_TYPE status; if ((pid < -1) || (pid == 0)) { errno = EINVAL; return -1; } |
︙ | ︙ |
Changes to compat/zlib/contrib/minizip/crypt.h.
︙ | ︙ | |||
53 54 55 56 57 58 59 | */ static int update_keys(unsigned long* pkeys,const z_crc_t* pcrc_32_tab,int c) { (*(pkeys+0)) = CRC32((*(pkeys+0)), c); (*(pkeys+1)) += (*(pkeys+0)) & 0xff; (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1; { | | | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | */ static int update_keys(unsigned long* pkeys,const z_crc_t* pcrc_32_tab,int c) { (*(pkeys+0)) = CRC32((*(pkeys+0)), c); (*(pkeys+1)) += (*(pkeys+0)) & 0xff; (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1; { int keyshift = (int)((*(pkeys+1)) >> 24); (*(pkeys+2)) = CRC32((*(pkeys+2)), keyshift); } return c; } /*********************************************************************** |
︙ | ︙ |
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/regcomp.c.
︙ | ︙ | |||
508 509 510 511 512 513 514 | ^ static int freev(struct vars *, int); */ static int freev( struct vars *v, int err) { | | | 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 | ^ static int freev(struct vars *, int); */ static int freev( struct vars *v, int err) { int ret; if (v->re != NULL) { rfree(v->re); } if (v->subs != v->sub10) { FREE(v->subs); } |
︙ | ︙ |
Changes to generic/regexec.c.
︙ | ︙ | |||
87 88 89 90 91 92 93 | struct smalldfa { struct dfa dfa; struct sset ssets[FEWSTATES*2]; unsigned statesarea[FEWSTATES*2 + WORK]; struct sset *outsarea[FEWSTATES*2 * FEWCOLORS]; struct arcp incarea[FEWSTATES*2 * FEWCOLORS]; }; | < | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | struct smalldfa { struct dfa dfa; struct sset ssets[FEWSTATES*2]; unsigned statesarea[FEWSTATES*2 + WORK]; struct sset *outsarea[FEWSTATES*2 * FEWCOLORS]; struct arcp incarea[FEWSTATES*2 * FEWCOLORS]; }; /* * Internal variables, bundled for easy passing around. */ struct vars { regex_t *re; |
︙ | ︙ | |||
295 296 297 298 299 300 301 | * The DFA will be freed by the cleanup step in exec(). */ static struct dfa * getsubdfa(struct vars * v, struct subre * t) { if (v->subdfas[t->id] == NULL) { | | | 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 | * The DFA will be freed by the cleanup step in exec(). */ static struct dfa * getsubdfa(struct vars * v, struct subre * t) { if (v->subdfas[t->id] == NULL) { v->subdfas[t->id] = newDFA(v, &t->cnfa, &v->g->cmap, NULL); if (ISERR()) return NULL; } return v->subdfas[t->id]; } /* |
︙ | ︙ |
Changes to generic/tclAlloc.c.
︙ | ︙ | |||
249 250 251 252 253 254 255 | *---------------------------------------------------------------------- */ char * TclpAlloc( unsigned int numBytes) /* Number of bytes to allocate. */ { | | | | | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 | *---------------------------------------------------------------------- */ char * TclpAlloc( unsigned int numBytes) /* Number of bytes to allocate. */ { union overhead *overPtr; size_t bucket; unsigned 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. |
︙ | ︙ | |||
444 445 446 447 448 449 450 | *---------------------------------------------------------------------- */ void TclpFree( char *oldPtr) /* Pointer to memory to free. */ { | | | | 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 | *---------------------------------------------------------------------- */ void TclpFree( char *oldPtr) /* Pointer to memory to free. */ { size_t size; union overhead *overPtr; struct block *bigBlockPtr; if (oldPtr == NULL) { return; } Tcl_MutexLock(allocMutexPtr); |
︙ | ︙ | |||
641 642 643 644 645 646 647 | */ #ifdef MSTATS void mstats( char *s) /* Where to write info. */ { | | | | 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 | */ #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.
︙ | ︙ | |||
849 850 851 852 853 854 855 | 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 */ | | | 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 | 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 */ int sourceLen; /* Length of the source code in bytes */ |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
1301 1302 1303 1304 1305 1306 1307 | *---------------------------------------------------------------------- */ int TclHideUnsafeCommands( Tcl_Interp *interp) /* Hide commands in this interpreter. */ { | | | | 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 | *---------------------------------------------------------------------- */ 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); |
︙ | ︙ | |||
2828 2829 2830 2831 2832 2833 2834 | *---------------------------------------------------------------------- */ int TclInvokeStringCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ | | | 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 | *---------------------------------------------------------------------- */ 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 = (Command *)clientData; int i, result; const char **argv = (const char **) TclStackAlloc(interp, (objc + 1) * sizeof(char *)); |
︙ | ︙ | |||
2877 2878 2879 2880 2881 2882 2883 | */ int TclInvokeObjectCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ | | | 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 | */ 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 = ( Command *) clientData; Tcl_Obj *objPtr; int i, length, result; Tcl_Obj **objv = (Tcl_Obj **) TclStackAlloc(interp, (argc * sizeof(Tcl_Obj *))); |
︙ | ︙ | |||
3368 3369 3370 3371 3372 3373 3374 | * 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; | | | 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 | * 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. */ |
︙ | ︙ | |||
3652 3653 3654 3655 3656 3657 3658 | * 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. */ { | | | 3652 3653 3654 3655 3656 3657 3658 3659 3660 3661 3662 3663 3664 3665 3666 | * 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) { /* |
︙ | ︙ | |||
3842 3843 3844 3845 3846 3847 3848 | * deleted or when the last ByteCode referring to it is freed. * *---------------------------------------------------------------------- */ void TclCleanupCommand( | | | 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 | * 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) { ckfree(cmdPtr); } } |
︙ | ︙ | |||
4233 4234 4235 4236 4237 4238 4239 | *---------------------------------------------------------------------- */ int TclInterpReady( Tcl_Interp *interp) { | | | 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 | *---------------------------------------------------------------------- */ int TclInterpReady( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; /* * Reset both the interpreter's string and object results and clear out * any previous error information. */ Tcl_ResetResult(interp); |
︙ | ︙ | |||
4305 4306 4307 4308 4309 4310 4311 | */ int TclResetCancellation( Tcl_Interp *interp, int force) { | | | 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 | */ int TclResetCancellation( Tcl_Interp *interp, int force) { Interp *iPtr = (Interp *) interp; if (iPtr == NULL) { return TCL_ERROR; } if (force || (iPtr->numLevels == 0)) { TclUnsetCancelFlags(iPtr); |
︙ | ︙ | |||
4347 4348 4349 4350 4351 4352 4353 | */ int Tcl_Canceled( Tcl_Interp *interp, int flags) { | | | 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 | */ 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)) { |
︙ | ︙ | |||
5868 5869 5870 5871 5872 5873 5874 | void TclAdvanceLines( int *line, const char *start, const char *end) { | | | 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 | void TclAdvanceLines( int *line, const char *start, const char *end) { const char *p; for (p = start; p < end; p++) { if (*p == '\n') { (*line)++; } } } |
︙ | ︙ | |||
6394 6395 6396 6397 6398 6399 6400 | *---------------------------------------------------------------------- */ int Tcl_EvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ | | | | | 6394 6395 6396 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439 6440 | *---------------------------------------------------------------------- */ 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. */ { |
︙ | ︙ | |||
6734 6735 6736 6737 6738 6739 6740 | 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. */ { | | | 6734 6735 6736 6737 6738 6739 6740 6741 6742 6743 6744 6745 6746 6747 6748 | 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; |
︙ | ︙ | |||
6761 6762 6763 6764 6765 6766 6767 | 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. */ { | | | 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 | 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. */ |
︙ | ︙ | |||
6841 6842 6843 6844 6845 6846 6847 | *-------------------------------------------------------------- */ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ | | | 6841 6842 6843 6844 6845 6846 6847 6848 6849 6850 6851 6852 6853 6854 6855 | *-------------------------------------------------------------- */ 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; |
︙ | ︙ | |||
6888 6889 6890 6891 6892 6893 6894 | return result; } int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ | | | 6888 6889 6890 6891 6892 6893 6894 6895 6896 6897 6898 6899 6900 6901 6902 | 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); |
︙ | ︙ | |||
6924 6925 6926 6927 6928 6929 6930 | return result; } int Tcl_ExprBooleanObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ | | | 6924 6925 6926 6927 6928 6929 6930 6931 6932 6933 6934 6935 6936 6937 6938 | 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) { |
︙ | ︙ | |||
7036 7037 7038 7039 7040 7041 7042 | int TclNRInvoke( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { | | | 7036 7037 7038 7039 7040 7041 7042 7043 7044 7045 7046 7047 7048 7049 7050 | 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; |
︙ | ︙ | |||
7231 7232 7233 7234 7235 7236 7237 | Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ const char *message, /* Points to the first byte of an array of * bytes of the message. */ int length) /* The number of bytes in the message. If < 0, * then append all bytes up to a NULL byte. */ { | | | 7231 7232 7233 7234 7235 7236 7237 7238 7239 7240 7241 7242 7243 7244 7245 | Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ const char *message, /* Points to the first byte of an array of * bytes of the message. */ int length) /* The number of bytes in the message. If < 0, * then append all bytes up to a NULL byte. */ { Interp *iPtr = (Interp *) interp; /* * If we are just starting to log an error, errorInfo is initialized from * the error message in the interpreter's result. */ iPtr->flags |= ERR_LEGACY_COPY; |
︙ | ︙ | |||
7381 7382 7383 7384 7385 7386 7387 | #undef Tcl_GlobalEval int Tcl_GlobalEval( Tcl_Interp *interp, /* Interpreter in which to evaluate * command. */ const char *command) /* Command to evaluate. */ { | | | 7381 7382 7383 7384 7385 7386 7387 7388 7389 7390 7391 7392 7393 7394 7395 | #undef Tcl_GlobalEval int Tcl_GlobalEval( Tcl_Interp *interp, /* Interpreter in which to evaluate * command. */ const char *command) /* Command to evaluate. */ { Interp *iPtr = (Interp *) interp; int result; CallFrame *savedVarFramePtr; savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; result = Tcl_EvalEx(interp, command, -1, 0); iPtr->varFramePtr = savedVarFramePtr; |
︙ | ︙ |
Changes to generic/tclBinary.c.
︙ | ︙ | |||
2284 2285 2286 2287 2288 2289 2290 | value -= (((unsigned) 1) << 31); } returnNumericObject: if (*numberCachePtrPtr == NULL) { return Tcl_NewWideIntObj(value); } else { | | | | | 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 | 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_Obj *)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; } /* |
︙ | ︙ |
Changes to generic/tclCmdAH.c.
︙ | ︙ | |||
164 165 166 167 168 169 170 | int Tcl_CaseObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | int Tcl_CaseObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i; int body, result, caseObjc; const char *stringPtr, *arg; Tcl_Obj *const *caseObjv; Tcl_Obj *armPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, |
︙ | ︙ | |||
867 868 869 870 871 872 873 | int TclNREvalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 | 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; |
︙ | ︙ | |||
2249 2250 2251 2252 2253 2254 2255 | 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; | | | 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 | 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. |
︙ | ︙ |
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; int 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. */ |
︙ | ︙ | |||
2411 2412 2413 2414 2415 2416 2417 | *---------------------------------------------------------------------- */ int Tcl_LinsertObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ | | | 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 | *---------------------------------------------------------------------- */ 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; int index, len, result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?"); |
︙ | ︙ | |||
2493 2494 2495 2496 2497 2498 2499 | *---------------------------------------------------------------------- */ int Tcl_ListObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ | | | | 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 | *---------------------------------------------------------------------- */ 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. */ |
︙ | ︙ | |||
2530 2531 2532 2533 2534 2535 2536 | */ int Tcl_LlengthObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ | | | 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 | */ 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; |
︙ | ︙ | |||
2576 2577 2578 2579 2580 2581 2582 | */ int Tcl_LpopObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ | | | 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 | */ 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) { |
︙ | ︙ | |||
2669 2670 2671 2672 2673 2674 2675 | */ int Tcl_LrangeObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ | | | 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 | */ 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, first, last, result; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); return TCL_ERROR; |
︙ | ︙ | |||
2855 2856 2857 2858 2859 2860 2861 | *---------------------------------------------------------------------- */ int Tcl_LrepeatObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ | | | | 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 | *---------------------------------------------------------------------- */ 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: |
︙ | ︙ | |||
2921 2922 2923 2924 2925 2926 2927 | * 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) { | | | 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 | * 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; |
︙ | ︙ | |||
2967 2968 2969 2970 2971 2972 2973 | int Tcl_LreplaceObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 | 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; int first, last, listLen, numToDelete, result; if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last ?element ...?"); return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
1658 1659 1660 1661 1662 1663 1664 | * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetDictFromAny(). */ const char *elemStart, *nextElem; int lenRemain, elemSize; | | | 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 | * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetDictFromAny(). */ const char *elemStart, *nextElem; int lenRemain, 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, |
︙ | ︙ | |||
1838 1839 1840 1841 1842 1843 1844 | * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetListFromAny(). */ const char *elemStart, *nextElem; int lenRemain, elemSize; | | | 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 | * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetListFromAny(). */ const char *elemStart, *nextElem; int lenRemain, 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, |
︙ | ︙ | |||
4056 4057 4058 4059 4060 4061 4062 | int Tcl_TimeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 | 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 |
︙ | ︙ | |||
4157 4158 4159 4160 4161 4162 4163 | 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 */ | | | | | 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 | 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; TclWideMUInt count = 0; /* Holds repetition count */ Tcl_WideInt maxms = WIDE_MIN; /* Maximal running time (in milliseconds) */ TclWideMUInt maxcnt = WIDE_MAX; /* Maximal count of iterations. */ TclWideMUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ TclWideMUInt 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.
︙ | ︙ | |||
2910 2911 2912 2913 2914 2915 2916 | static ClientData DupForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { ForeachInfo *srcPtr = (ForeachInfo *)clientData; ForeachInfo *dupPtr; | | | 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 | static ClientData DupForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { ForeachInfo *srcPtr = (ForeachInfo *)clientData; ForeachInfo *dupPtr; ForeachVarList *srcListPtr, *dupListPtr; int numVars, i, j, numLists = srcPtr->numLists; dupPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo) + numLists * sizeof(ForeachVarList *)); dupPtr->numLists = numLists; dupPtr->firstValueTemp = srcPtr->firstValueTemp; dupPtr->loopCtTemp = srcPtr->loopCtTemp; |
︙ | ︙ | |||
2960 2961 2962 2963 2964 2965 2966 | FreeForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to free. */ { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *listPtr; int numLists = infoPtr->numLists; | | | 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 | FreeForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to free. */ { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *listPtr; int numLists = infoPtr->numLists; int i; for (i = 0; i < numLists; i++) { listPtr = infoPtr->varLists[i]; ckfree(listPtr); } ckfree(infoPtr); } |
︙ | ︙ | |||
3435 3436 3437 3438 3439 3440 3441 | 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. */ { | | | | 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 | 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; int n; Tcl_Token *elemTokenPtr = NULL; int nameLen, elNameLen, 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 * to emit code to compute and push the name at runtime. We use a frame |
︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
︙ | ︙ | |||
1858 1859 1860 1861 1862 1863 1864 | * 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--) { | | | | 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 | * 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--) { unsigned 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). */ |
︙ | ︙ |
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 1057 | * 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; int numAuxDataItems = codePtr->numAuxDataItems; 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; |
︙ | ︙ | |||
1388 1389 1390 1391 1392 1393 1394 | * the cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeSubstCodeInternalRep( | | | | 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 | * 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); } |
︙ | ︙ | |||
1439 1440 1441 1442 1443 1444 1445 | *---------------------------------------------------------------------- */ void TclInitCompileEnv( Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ | | | 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 | *---------------------------------------------------------------------- */ 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. */ int 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 */ { |
︙ | ︙ | |||
1646 1647 1648 1649 1650 1651 1652 | * corresponding ByteCode structure. * *---------------------------------------------------------------------- */ void TclFreeCompileEnv( | | | 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 | * corresponding ByteCode structure. * *---------------------------------------------------------------------- */ void TclFreeCompileEnv( CompileEnv *envPtr)/* Points to the CompileEnv structure. */ { if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){ ckfree(envPtr->localLitTable.buckets); envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets; } if (envPtr->iPtr) { /* |
︙ | ︙ | |||
2778 2779 2780 2781 2782 2783 2784 | envPtr->literalArrayPtr[i].objPtr = copyPtr; } } } ByteCode * TclInitByteCode( | | | | | 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 | envPtr->literalArrayPtr[i].objPtr = copyPtr; } } } 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 auxDataArrayBytes, structureSize; unsigned char *p; #ifdef TCL_COMPILE_DEBUG unsigned char *nextPtr; #endif int numLitObjects = envPtr->literalArrayNext; Namespace *namespacePtr; int i, isNew; Interp *iPtr; |
︙ | ︙ | |||
2919 2920 2921 2922 2923 2924 2925 | ByteCode * TclInitByteCodeObj( Tcl_Obj *objPtr, /* Points object that should be initialized, * and whose string rep contains the source * code. */ const Tcl_ObjType *typePtr, | | | 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 | 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); |
︙ | ︙ | |||
2964 2965 2966 2967 2968 2969 2970 | * variable is unknown, or if the name is NULL. * *---------------------------------------------------------------------- */ int TclFindCompiledLocal( | | | | | 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 | * 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. */ int 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? */ |
︙ | ︙ | |||
3347 3348 3349 3350 3351 3352 3353 | * *---------------------------------------------------------------------- */ int TclCreateExceptRange( ExceptionRangeType type, /* The kind of ExceptionRange desired. */ | | | | | 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 | * *---------------------------------------------------------------------- */ 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]. |
︙ | ︙ | |||
3715 3716 3717 3718 3719 3720 3721 | 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 */ | | | | 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 | 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. */ { int index; /* Index for the new AuxData structure. */ AuxData *auxDataPtr; /* Points to the new AuxData structure */ index = envPtr->auxDataArrayNext; if (index >= envPtr->auxDataArrayEnd) { /* * Expand the AuxData array. The currently allocated entries are * stored between elements 0 and (envPtr->auxDataArrayNext - 1) |
︙ | ︙ | |||
3778 3779 3780 3781 3782 3783 3784 | * The JumpFixupArray structure is initialized. * *---------------------------------------------------------------------- */ void TclInitJumpFixupArray( | | | 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 | * The JumpFixupArray structure is initialized. * *---------------------------------------------------------------------- */ void TclInitJumpFixupArray( JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * initialize. */ { fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace; fixupArrayPtr->next = 0; fixupArrayPtr->end = JUMPFIXUP_INIT_ENTRIES - 1; fixupArrayPtr->mallocedArray = 0; |
︙ | ︙ | |||
3810 3811 3812 3813 3814 3815 3816 | * array to the new one. * *---------------------------------------------------------------------- */ void TclExpandJumpFixupArray( | | | 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 | * array to the new one. * *---------------------------------------------------------------------- */ void TclExpandJumpFixupArray( JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * enlarge. */ { /* * The currently allocated jump fixup entries are stored from fixup[0] up * to fixup[fixupArrayPtr->fixupNext] (*not* inclusive). We assume * fixupArrayPtr->fixupNext is equal to fixupArrayPtr->fixupEnd. |
︙ | ︙ | |||
3859 3860 3861 3862 3863 3864 3865 | * Allocated storage in the JumpFixupArray structure is freed. * *---------------------------------------------------------------------- */ void TclFreeJumpFixupArray( | | | 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 | * Allocated storage in the JumpFixupArray structure is freed. * *---------------------------------------------------------------------- */ void TclFreeJumpFixupArray( JumpFixupArray *fixupArrayPtr) /* Points to the JumpFixupArray structure to * free. */ { if (fixupArrayPtr->mallocedArray) { ckfree(fixupArrayPtr->fixup); } } |
︙ | ︙ | |||
4306 4307 4308 4309 4310 4311 4312 | static int GetCmdLocEncodingSize( CompileEnv *envPtr) /* Points to compilation environment structure * containing the CmdLocation structure to * encode. */ { | | | 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 | static int GetCmdLocEncodingSize( CompileEnv *envPtr) /* Points to compilation environment structure * containing the CmdLocation structure to * encode. */ { CmdLocation *mapPtr = envPtr->cmdMapPtr; int numCmds = envPtr->numCommands; int codeDelta, codeLen, srcDelta, srcLen; int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext; /* The offsets in their respective byte * sequences where the next encoded offset or * length should go. */ int prevCodeOffset, prevSrcOffset, i; |
︙ | ︙ | |||
4390 4391 4392 4393 4394 4395 4396 | * 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. */ { | | | | | 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 | * 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. */ { CmdLocation *mapPtr = envPtr->cmdMapPtr; int numCmds = envPtr->numCommands; unsigned char *p = startPtr; int codeDelta, codeLen, srcDelta, srcLen, prevOffset; int i; /* * Encode the code offset for each command as a sequence of deltas. */ codePtr->codeDeltaStart = p; prevOffset = 0; |
︙ | ︙ | |||
4508 4509 4510 4511 4512 4513 4514 | void RecordByteCodeStats( ByteCode *codePtr) /* Points to ByteCode structure with info * to add to accumulated statistics. */ { Interp *iPtr = (Interp *) *codePtr->interpHandle; | | | 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 | 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/tclDate.c.
︙ | ︙ | |||
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 | * Bison generates several labels that happen to be unused. MS Visual C++ * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; | > > > > > > > > > > > | | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | * Bison generates several labels that happen to be unused. MS Visual C++ * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * Meridian: am, pm, or 24-hour style. */ typedef enum _MERIDIAN { MERam, MERpm, MER24 } MERIDIAN; /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; MERIDIAN dateMeridian; int dateHaveTime; time_t dateTimezone; int dateDSTmode; int dateHaveZone; time_t dateRelMonth; |
︙ | ︙ | |||
194 195 196 197 198 199 200 | /* * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; | < < < < < < < < < < < | 205 206 207 208 209 210 211 212 213 214 215 216 217 218 | /* * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; # ifndef YY_NULLPTR # if defined __cplusplus && 201103L <= __cplusplus # define YY_NULLPTR nullptr # else # define YY_NULLPTR 0 # endif |
︙ | ︙ | |||
2545 2546 2547 2548 2549 2550 2551 | } static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { | | | | | 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 | } static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { char *p; char *q; const TABLE *tp; int i, abbrev; /* * Make it lowercase. */ Tcl_UtfToLower(buff); |
︙ | ︙ | |||
2670 2671 2672 2673 2674 2675 2676 | static int TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { | | | | 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 | static int TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { char c; char *p; char buff[20]; int Count; location->first_column = yyInput - info->dateStart; for ( ; ; ) { while (TclIsSpaceProc(UCHAR(*yyInput))) { yyInput++; |
︙ | ︙ |
Changes to generic/tclDisassemble.c.
︙ | ︙ | |||
538 539 540 541 542 543 544 | 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; | | | 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 | 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. */ |
︙ | ︙ | |||
859 860 861 862 863 864 865 | 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. */ { | | | | 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 | 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. */ int stringLength, i; int 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. */ int stringLength, i; int 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 |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
1323 1324 1325 1326 1327 1328 1329 | *-------------------------------------------------------------- */ int Tcl_ExprObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ | | | 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 | *-------------------------------------------------------------- */ int Tcl_ExprObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Points to Tcl object containing expression * to evaluate. */ Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression * result is stored if no errors occur. */ { NRE_callback *rootPtr = TOP_CB(interp); Tcl_Obj *resultPtr; |
︙ | ︙ | |||
1440 1441 1442 1443 1444 1445 1446 | CompileExprObj( Tcl_Interp *interp, Tcl_Obj *objPtr) { Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ | | | 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 | CompileExprObj( Tcl_Interp *interp, Tcl_Obj *objPtr) { Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ /* * Get the expression ByteCode from the object. If it exists, make sure it * is valid in the current context. */ |
︙ | ︙ | |||
1594 1595 1596 1597 1598 1599 1600 | ByteCode * TclCompileObj( Tcl_Interp *interp, Tcl_Obj *objPtr, const CmdFrame *invoker, int word) { | | | | 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 | ByteCode * TclCompileObj( Tcl_Interp *interp, Tcl_Obj *objPtr, const CmdFrame *invoker, int word) { Interp *iPtr = (Interp *) interp; ByteCode *codePtr; /* Tcl Internal type of bytecode. */ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; /* * If the object is not already of tclByteCodeType, compile it (and reset * the compilation flags in the interpreter; this should be done after any * compilation). Otherwise, check that it is "fresh" enough. */ |
︙ | ︙ | |||
2497 2498 2499 2500 2501 2502 2503 | CACHE_STACK_INFO(); goto gotError; } #ifdef TCL_COMPILE_DEBUG /* FIXME: What is the right thing to trace? */ { | | | 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 | CACHE_STACK_INFO(); goto gotError; } #ifdef TCL_COMPILE_DEBUG /* FIXME: What is the right thing to trace? */ { int i; TRACE(("%d [", opnd)); for (i=opnd-1 ; i>=0 ; i--) { TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_DEPTH(i)))); if (i > 0) { TRACE_APPEND((" ")); } |
︙ | ︙ | |||
4407 4408 4409 4410 4411 4412 4413 | } case INST_INFO_LEVEL_NUM: TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_INFO_LEVEL_ARGS: { int level; | | | | 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 | } case INST_INFO_LEVEL_NUM: TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_INFO_LEVEL_ARGS: { int level; CallFrame *framePtr = iPtr->varFramePtr; CallFrame *rootFramePtr = iPtr->rootFramePtr; TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } if (level <= 0) { |
︙ | ︙ | |||
4705 4706 4707 4708 4709 4710 4711 | || contextPtr->callPtr->flags & FILTER_HANDLING) { oPtr->flags |= FILTER_HANDLING; } else { oPtr->flags &= ~FILTER_HANDLING; } { | | | 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 | || contextPtr->callPtr->flags & FILTER_HANDLING) { oPtr->flags |= FILTER_HANDLING; } else { oPtr->flags &= ~FILTER_HANDLING; } { Method *const mPtr = contextPtr->callPtr->chain[newDepth].mPtr; return mPtr->typePtr->callProc(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, opnd, objv); } case INST_TCLOO_IS_OBJECT: |
︙ | ︙ | |||
6795 6796 6797 6798 6799 6800 6801 | O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); case INST_DICT_EXISTS: { | | | 6795 6796 6797 6798 6799 6800 6801 6802 6803 6804 6805 6806 6807 6808 6809 | O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); NEXT_INST_F(1, 1, 0); case INST_DICT_EXISTS: { int found; opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); dictPtr = OBJ_AT_DEPTH(opnd); if (opnd > 1) { dictPtr = TclTraceDictPath(NULL, dictPtr, opnd-1, &OBJ_AT_DEPTH(opnd-1), DICT_PATH_EXISTS); |
︙ | ︙ | |||
8896 8897 8898 8899 8900 8901 8902 | * None. * *---------------------------------------------------------------------- */ static void PrintByteCodeInfo( | | | 8896 8897 8898 8899 8900 8901 8902 8903 8904 8905 8906 8907 8908 8909 8910 | * None. * *---------------------------------------------------------------------- */ static void PrintByteCodeInfo( ByteCode *codePtr) /* The bytecode whose summary is printed to * stdout. */ { Proc *procPtr = codePtr->procPtr; Interp *iPtr = (Interp *) *codePtr->interpHandle; fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n", codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr, |
︙ | ︙ | |||
8960 8961 8962 8963 8964 8965 8966 | * *---------------------------------------------------------------------- */ #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( | | | 8960 8961 8962 8963 8964 8965 8966 8967 8968 8969 8970 8971 8972 8973 8974 | * *---------------------------------------------------------------------- */ #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( ByteCode *codePtr, /* The bytecode whose summary is printed to * stdout. */ const unsigned char *pc, /* Points to first byte of a bytecode * instruction. The program counter. */ int stackTop, /* Current stack top. Must be between * stackLowerBound and stackUpperBound * (inclusive). */ int checkStack) /* 0 if the stack depth check should be |
︙ | ︙ | |||
9203 9204 9205 9206 9207 9208 9209 | const unsigned char **pcBeg,/* If non-NULL, the bytecode location * where the current instruction starts. * If NULL; no pointer is stored. */ int *cmdIdxPtr) /* If non-NULL, the location where the index * of the command containing the pc should * be stored. */ { | | | 9203 9204 9205 9206 9207 9208 9209 9210 9211 9212 9213 9214 9215 9216 9217 | const unsigned char **pcBeg,/* If non-NULL, the bytecode location * where the current instruction starts. * If NULL; no pointer is stored. */ int *cmdIdxPtr) /* If non-NULL, the location where the index * of the command containing the pc should * be stored. */ { int pcOffset = (pc - codePtr->codeStart); int numCmds = codePtr->numCommands; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */ int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */ int bestSrcLength = -1; /* Initialized to avoid compiler warning. */ |
︙ | ︙ | |||
9356 9357 9358 9359 9360 9361 9362 | * for loop ranges that define a continue * point or a catch range. */ ByteCode *codePtr) /* Points to the ByteCode in which to search * for the enclosing ExceptionRange. */ { ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; | | | | 9356 9357 9358 9359 9360 9361 9362 9363 9364 9365 9366 9367 9368 9369 9370 9371 9372 | * for loop ranges that define a continue * point or a catch range. */ ByteCode *codePtr) /* Points to the ByteCode in which to search * for the enclosing ExceptionRange. */ { ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; ExceptionRange *rangePtr; int pcOffset = pc - codePtr->codeStart; int start; if (numRanges == 0) { return NULL; } /* * This exploits peculiarities of our compiler: nested ranges are always |
︙ | ︙ | |||
9490 9491 9492 9493 9494 9495 9496 | * None. * *---------------------------------------------------------------------- */ int TclLog2( | | | | | 9490 9491 9492 9493 9494 9495 9496 9497 9498 9499 9500 9501 9502 9503 9504 9505 9506 9507 9508 | * None. * *---------------------------------------------------------------------- */ int TclLog2( int value) /* The integer for which to compute the log * base 2. */ { int n = value; int result = 0; while (n > 1) { n = n >> 1; result++; } return result; } |
︙ | ︙ |
Changes to generic/tclFileName.c.
︙ | ︙ | |||
1068 1069 1070 1071 1072 1073 1074 | /* * Convert forward slashes to backslashes in Windows paths because some * system interfaces don't accept forward slashes. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { | | | 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 | /* * 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 = '\\'; } } } |
︙ | ︙ | |||
2073 2074 2075 2076 2077 2078 2079 | static int SkipToChar( char **stringPtr, /* Pointer string to check. */ int match) /* Character to find. */ { int quoted, level; | | | 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 | 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; |
︙ | ︙ | |||
2624 2625 2626 2627 2628 2629 2630 | Tcl_WideUInt Tcl_GetBlocksFromStat( const Tcl_StatBuf *statPtr) { #ifdef HAVE_STRUCT_STAT_ST_BLOCKS return (Tcl_WideUInt) statPtr->st_blocks; #else | | | 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 | 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/tclGetDate.y.
︙ | ︙ | |||
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; | > > > > > > > > | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | * doesn't like that, and complains. Tell it to shut up. */ #ifdef _MSC_VER #pragma warning( disable : 4102 ) #endif /* _MSC_VER */ /* * Meridian: am, pm, or 24-hour style. */ typedef enum _MERIDIAN { MERam, MERpm, MER24 } MERIDIAN; /* * yyparse will accept a 'struct DateInfo' as its parameter; that's where the * parsed fields will be returned. */ typedef struct DateInfo { Tcl_Obj* messages; /* Error messages */ const char* separatrix; /* String separating messages */ time_t dateYear; time_t dateMonth; time_t dateDay; int dateHaveDate; time_t dateHour; time_t dateMinutes; time_t dateSeconds; MERIDIAN dateMeridian; int dateHaveTime; time_t dateTimezone; int dateDSTmode; int dateHaveZone; time_t dateRelMonth; |
︙ | ︙ | |||
146 147 148 149 150 151 152 | * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; | < < < < < < < < | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | * Daylight-savings mode: on, off, or not yet known. */ typedef enum _DSTMODE { DSTon, DSToff, DSTmaybe } DSTMODE; %} %union { time_t Number; enum _MERIDIAN Meridian; } |
︙ | ︙ | |||
761 762 763 764 765 766 767 | } static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { | | | | | 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 | } static int LookupWord( YYSTYPE* yylvalPtr, char *buff) { char *p; char *q; const TABLE *tp; int i, abbrev; /* * Make it lowercase. */ Tcl_UtfToLower(buff); |
︙ | ︙ | |||
886 887 888 889 890 891 892 | static int TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { | | | | 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 | static int TclDatelex( YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo *info) { char c; char *p; char buff[20]; int Count; location->first_column = yyInput - info->dateStart; for ( ; ; ) { while (TclIsSpaceProc(UCHAR(*yyInput))) { yyInput++; |
︙ | ︙ |
Changes to generic/tclHash.c.
︙ | ︙ | |||
109 110 111 112 113 114 115 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitHashTable( | | | 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | * 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. */ { /* |
︙ | ︙ | |||
147 148 149 150 151 152 153 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitCustomHashTable( | | | 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 | * 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 |
︙ | ︙ | |||
267 268 269 270 271 272 273 | 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. */ { | | | 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 | 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; unsigned int hash; int index; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { |
︙ | ︙ | |||
388 389 390 391 392 393 394 | *---------------------------------------------------------------------- */ void Tcl_DeleteHashEntry( Tcl_HashEntry *entryPtr) { | | | 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 | *---------------------------------------------------------------------- */ void Tcl_DeleteHashEntry( Tcl_HashEntry *entryPtr) { Tcl_HashEntry *prevPtr; const Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; int index; tablePtr = entryPtr->tablePtr; |
︙ | ︙ | |||
457 458 459 460 461 462 463 | * The hash table is no longer useable. * *---------------------------------------------------------------------- */ void Tcl_DeleteHashTable( | | | | 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 | * The hash table is no longer useable. * *---------------------------------------------------------------------- */ void Tcl_DeleteHashTable( Tcl_HashTable *tablePtr) /* Table to delete. */ { Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; int i; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { typePtr = &tclOneWordHashKeyType; |
︙ | ︙ | |||
565 566 567 568 569 570 571 | * None. * *---------------------------------------------------------------------- */ Tcl_HashEntry * Tcl_NextHashEntry( | | | 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 | * 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; |
︙ | ︙ | |||
612 613 614 615 616 617 618 | char * Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 int count[NUM_COUNTERS], overflow, i, j; double average, tmp; | | | 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 | char * Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 int 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++) { |
︙ | ︙ | |||
682 683 684 685 686 687 688 | static Tcl_HashEntry * AllocArrayEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { int *array = (int *) keyPtr; | | | 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 | 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; unsigned int size; count = tablePtr->keyType; size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key); |
︙ | ︙ | |||
726 727 728 729 730 731 732 | */ static int CompareArrayKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { | | | | 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 | */ static int CompareArrayKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { const int *iPtr1 = (const int *) keyPtr; const int *iPtr2 = (const int *) hPtr->key.words; Tcl_HashTable *tablePtr = hPtr->tablePtr; int count; for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) { if (count == 0) { return 1; } |
︙ | ︙ | |||
765 766 767 768 769 770 771 | */ static TCL_HASH_TYPE HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { | | | | 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 | */ 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; unsigned int result; int count; for (result = 0, count = tablePtr->keyType; count > 0; count--, array++) { result += *array; } return (TCL_HASH_TYPE) result; |
︙ | ︙ | |||
834 835 836 837 838 839 840 | */ static int CompareStringKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { | | | | 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 | */ static int CompareStringKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { const char *p1 = (const char *) keyPtr; const char *p2 = (const char *) hPtr->key.string; return !strcmp(p1, p2); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
983 984 985 986 987 988 989 | * Memory gets reallocated and entries get re-hashed to new buckets. * *---------------------------------------------------------------------- */ static void RebuildTable( | | | | | 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 | * Memory gets reallocated and entries get re-hashed to new buckets. * *---------------------------------------------------------------------- */ static void RebuildTable( Tcl_HashTable *tablePtr) /* Table to enlarge. */ { int 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 > (int)(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. */ |
︙ | ︙ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
7476 7477 7478 7479 7480 7481 7482 | int bytesBuffered; for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bytesBuffered += BytesLeft(bufPtr); } if (statePtr->curOutPtr != NULL) { | | | 7476 7477 7478 7479 7480 7481 7482 7483 7484 7485 7486 7487 7488 7489 7490 | 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; |
︙ | ︙ | |||
11231 11232 11233 11234 11235 11236 11237 | * representation. * *---------------------------------------------------------------------- */ static void DupChannelIntRep( | | | | 11231 11232 11233 11234 11235 11236 11237 11238 11239 11240 11241 11242 11243 11244 11245 11246 11247 | * 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.
︙ | ︙ | |||
422 423 424 425 426 427 428 | * *---------------------------------------------------------------------- */ static int SetIndexFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 | * *---------------------------------------------------------------------- */ 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; |
︙ | ︙ | |||
454 455 456 457 458 459 460 | */ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { IndexRep *indexRep = (IndexRep *)TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; | | | 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 | */ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { IndexRep *indexRep = (IndexRep *)TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; const char *indexStr = EXPAND_OF(indexRep); Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr)); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1103 1104 1105 1106 1107 1108 1109 | * 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.*/ | | | | 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 | * 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 |
︙ | ︙ | |||
1358 1359 1360 1361 1362 1363 1364 | PrintUsage( Tcl_Interp *interp, /* Place information in this interp's result * area. */ const Tcl_ArgvInfo *argTable) /* Array of command-specific argument * descriptions. */ { | | | 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 | 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.
︙ | ︙ | |||
3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 | 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); | > | 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 | 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.
︙ | ︙ | |||
553 554 555 556 557 558 559 | * *---------------------------------------------------------------------- */ int Tcl_ListObjGetElements( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | | 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 | * *---------------------------------------------------------------------- */ 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, length; (void) Tcl_GetStringFromObj(listPtr, &length); |
︙ | ︙ | |||
610 611 612 613 614 615 616 | * *---------------------------------------------------------------------- */ int Tcl_ListObjAppendList( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 | * *---------------------------------------------------------------------- */ 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"); |
︙ | ︙ | |||
669 670 671 672 673 674 675 | 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. */ { | | | 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 | 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); |
︙ | ︙ | |||
840 841 842 843 844 845 846 | * *---------------------------------------------------------------------- */ int Tcl_ListObjIndex( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | | | 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 | * *---------------------------------------------------------------------- */ 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, length; (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { |
︙ | ︙ | |||
896 897 898 899 900 901 902 | * *---------------------------------------------------------------------- */ int Tcl_ListObjLength( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | | | 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 | * *---------------------------------------------------------------------- */ 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, length; (void) Tcl_GetStringFromObj(listPtr, &length); if (length == 0) { |
︙ | ︙ | |||
970 971 972 973 974 975 976 | 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; | | | 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 | 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.
︙ | ︙ | |||
54 55 56 57 58 59 60 | * The literal table is made ready for use. * *---------------------------------------------------------------------- */ void TclInitLiteralTable( | | | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | * 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 |
︙ | ︙ | |||
385 386 387 388 389 390 391 | *---------------------------------------------------------------------- */ int TclRegisterLiteral( void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ | | | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 | *---------------------------------------------------------------------- */ 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. */ int length, /* Number of bytes in the string. If < 0, 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 |
︙ | ︙ | |||
495 496 497 498 499 500 501 | *---------------------------------------------------------------------- */ static LiteralEntry * LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ | | | | 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 | *---------------------------------------------------------------------- */ 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; int length, globalHash; bytes = TclGetStringFromObj(objPtr, &length); globalHash = (HashString(bytes, length) & globalTablePtr->mask); for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL; entryPtr=entryPtr->nextPtr) { |
︙ | ︙ | |||
541 542 543 544 545 546 547 | *---------------------------------------------------------------------- */ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ | | | 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 | *---------------------------------------------------------------------- */ 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. */ { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; unsigned int localHash; |
︙ | ︙ | |||
605 606 607 608 609 610 611 | * literal object. * *---------------------------------------------------------------------- */ int TclAddLiteralObj( | | | | 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 | * 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) /* The location where the pointer to the new * literal entry should be stored. May be * NULL. */ { LiteralEntry *lPtr; int objIndex; if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) { ExpandLocalLiteralArray(envPtr); } objIndex = envPtr->literalArrayNext; envPtr->literalArrayNext++; |
︙ | ︙ | |||
654 655 656 657 658 659 660 | * array of the CompileEnv's literal array if it becomes too large. * *---------------------------------------------------------------------- */ static int AddLocalLiteralEntry( | | | | 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 | * array of the CompileEnv's literal array if it becomes too large. * *---------------------------------------------------------------------- */ static int AddLocalLiteralEntry( CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */ int localHash) /* Hash value for the literal's string. */ { LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *localPtr; int objIndex; objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr); /* * Add the literal to the local table. |
︙ | ︙ | |||
732 733 734 735 736 737 738 | * The local literal table is updated to refer to the new entries. * *---------------------------------------------------------------------- */ static void ExpandLocalLiteralArray( | | | 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 | * 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]. */ |
︙ | ︙ | |||
814 815 816 817 818 819 820 | *---------------------------------------------------------------------- */ void TclReleaseLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ | | | | 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 | *---------------------------------------------------------------------- */ 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; int length; unsigned int index; if (iPtr == NULL) { goto done; } |
︙ | ︙ | |||
894 895 896 897 898 899 900 | * None. * *---------------------------------------------------------------------- */ static unsigned HashString( | | | | 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 | * None. * *---------------------------------------------------------------------- */ static unsigned HashString( const char *string, /* String for which to compute hash value. */ int length) /* Number of bytes in the string. */ { unsigned int 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: |
︙ | ︙ | |||
958 959 960 961 962 963 964 | * Memory gets reallocated and entries get rehashed into new buckets. * *---------------------------------------------------------------------- */ static void RebuildLiteralTable( | | | | | 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 | * 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; unsigned int oldSize, index; int count, length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; |
︙ | ︙ | |||
1094 1095 1096 1097 1098 1099 1100 | LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 size_t count[NUM_COUNTERS]; int overflow; size_t i, j; double average, tmp; | | | 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 | LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 size_t count[NUM_COUNTERS]; int overflow; size_t 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. */ |
︙ | ︙ | |||
1165 1166 1167 1168 1169 1170 1171 | */ void TclVerifyLocalLiteralTable( CompileEnv *envPtr) /* Points to CompileEnv whose literal table is * to be validated. */ { | | | | 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 | */ void TclVerifyLocalLiteralTable( CompileEnv *envPtr) /* Points to CompileEnv whose literal table is * to be validated. */ { LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *localPtr; char *bytes; size_t i, count; int length; count = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; |
︙ | ︙ | |||
1216 1217 1218 1219 1220 1221 1222 | */ void TclVerifyGlobalLiteralTable( Interp *iPtr) /* Points to interpreter whose global literal * table is to be validated. */ { | | | | 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 | */ 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, count; int length; count = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; |
︙ | ︙ |
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. */ |
︙ | ︙ | |||
675 676 677 678 679 680 681 | 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; | | | 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 | 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, nameLen; |
︙ | ︙ | |||
844 845 846 847 848 849 850 | Tcl_DStringInit(&buffer1); Tcl_DStringInit(&buffer2); namePtr = &buffer1; buffPtr = &buffer2; for (ancestorPtr = nsPtr; ancestorPtr != NULL; ancestorPtr = ancestorPtr->parentPtr) { if (ancestorPtr != globalNsPtr) { | | | 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 | 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 |
︙ | ︙ | |||
918 919 920 921 922 923 924 | *---------------------------------------------------------------------- */ void Tcl_DeleteNamespace( Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */ { | | | 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 | *---------------------------------------------------------------------- */ 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; |
︙ | ︙ | |||
1114 1115 1116 1117 1118 1119 1120 | * Deletes all commands, variables and namespaces in this namespace. * *---------------------------------------------------------------------- */ void TclTeardownNamespace( | | | | 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 | * 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; int 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. |
︙ | ︙ | |||
1307 1308 1309 1310 1311 1312 1313 | * None. * *---------------------------------------------------------------------- */ static void NamespaceFree( | | | 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 | * 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. */ |
︙ | ︙ | |||
1582 1583 1584 1585 1586 1587 1588 | 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; | | | 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 | 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) { |
︙ | ︙ | |||
1861 1862 1863 1864 1865 1866 1867 | * 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; | | | 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 | * 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) { |
︙ | ︙ | |||
1988 1989 1990 1991 1992 1993 1994 | */ Tcl_Command TclGetOriginalCommand( Tcl_Command command) /* The imported command for which the original * command should be returned. */ { | | | 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 | */ 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) { |
︙ | ︙ | |||
2077 2078 2079 2080 2081 2082 2083 | DeleteImportedCmd( ClientData clientData) /* Points to the imported command's * ImportedCmdData structure. */ { ImportedCmdData *dataPtr = (ImportedCmdData *)clientData; Command *realCmdPtr = dataPtr->realCmdPtr; Command *selfPtr = dataPtr->selfPtr; | | | 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 | DeleteImportedCmd( ClientData clientData) /* Points to the imported command's * ImportedCmdData structure. */ { ImportedCmdData *dataPtr = (ImportedCmdData *)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 |
︙ | ︙ | |||
2497 2498 2499 2500 2501 2502 2503 | * (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. */ | | | 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 | * (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; /* |
︙ | ︙ | |||
2568 2569 2570 2571 2572 2573 2574 | * 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; | | | | 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 | * 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 |
︙ | ︙ | |||
2680 2681 2682 2683 2684 2685 2686 | if (entryPtr != NULL) { cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); } } } } else { Namespace *nsPtr[2]; | | | 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 | if (entryPtr != NULL) { cmdPtr = (Command *)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 |
︙ | ︙ | |||
2754 2755 2756 2757 2758 2759 2760 | void TclResetShadowedCmdRefs( Tcl_Interp *interp, /* Interpreter containing the new command. */ Command *newCmdPtr) /* Points to the new command. */ { char *cmdName; Tcl_HashEntry *hPtr; | | | 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 | 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 = (Namespace **)TclStackAlloc(interp, trailSize * sizeof(Namespace *)); |
︙ | ︙ | |||
3004 3005 3006 3007 3008 3009 3010 | Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; Namespace *nsPtr, *childNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); const char *pattern = NULL; Tcl_DString buffer; | | | 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 | 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. */ |
︙ | ︙ | |||
3130 3131 3132 3133 3134 3135 3136 | 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; | | | 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 | 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; int length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg"); return TCL_ERROR; } |
︙ | ︙ | |||
3209 3210 3211 3212 3213 3214 3215 | static int NamespaceCurrentCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 | 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; } /* |
︙ | ︙ | |||
3274 3275 3276 3277 3278 3279 3280 | 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; | | | 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 | 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; } /* |
︙ | ︙ | |||
3629 3630 3631 3632 3633 3634 3635 | NamespaceForgetCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *pattern; | | | 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 3640 3641 3642 3643 | 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++) { |
︙ | ︙ | |||
3695 3696 3697 3698 3699 3700 3701 | 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; | | | 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 | 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; } |
︙ | ︙ | |||
3848 3849 3850 3851 3852 3853 3854 | * of extra arguments to form the command to evaluate. */ if (objc == 3) { cmdObjPtr = objv[2]; } else { Tcl_Obj *concatObjv[2]; | | | 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 | * 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; } |
︙ | ︙ | |||
4249 4250 4251 4252 4253 4254 4255 | static int NamespaceQualifiersCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 | 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; int length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } |
︙ | ︙ | |||
4504 4505 4506 4507 4508 4509 4510 | static int NamespaceTailCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 4504 4505 4506 4507 4508 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 | 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; } /* |
︙ | ︙ | |||
4707 4708 4709 4710 4711 4712 4713 | * the namespace, it's structure will be freed. * *---------------------------------------------------------------------- */ static void FreeNsNameInternalRep( | | | 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 | * 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); |
︙ | ︙ | |||
4754 4755 4756 4757 4758 4759 4760 | * *---------------------------------------------------------------------- */ static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ | | | 4754 4755 4756 4757 4758 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 | * *---------------------------------------------------------------------- */ 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); } |
︙ | ︙ | |||
4790 4791 4792 4793 4794 4795 4796 | */ static int SetNsNameFromAny( Tcl_Interp *interp, /* Points to the namespace in which to resolve * name. Also used for error reporting if not * NULL. */ | | | 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 | */ 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) { |
︙ | ︙ | |||
4917 4918 4919 4920 4921 4922 4923 | * the error. */ int 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 */ { | | | 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 | * the error. */ int 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.
︙ | ︙ | |||
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) { |
︙ | ︙ | |||
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; |
︙ | ︙ |
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 |
︙ | ︙ | |||
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. * |
︙ | ︙ |
Changes to generic/tclOODefineCmds.c.
︙ | ︙ | |||
775 776 777 778 779 780 781 | FindCommand( Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { int 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) { int 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 = (Method *)ckalloc(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 = (Method *)ckalloc(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 = (ProcedureMethod *)ckalloc(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"; } |
︙ | ︙ | |||
1383 1384 1385 1386 1387 1388 1389 | 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; | | | 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 | 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)); |
︙ | ︙ | |||
1422 1423 1424 1425 1426 1427 1428 | 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; | | | 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 | 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.
︙ | ︙ | |||
866 867 868 869 870 871 872 | 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. */ { | | | 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 | 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. */ |
︙ | ︙ | |||
914 915 916 917 918 919 920 | *---------------------------------------------------------------------- */ const Tcl_ObjType * Tcl_GetObjType( const char *typeName) /* Name of Tcl object type to look up. */ { | | | 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 | *---------------------------------------------------------------------- */ 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 = (const Tcl_ObjType *)Tcl_GetHashValue(hPtr); } |
︙ | ︙ | |||
1044 1045 1046 1047 1048 1049 1050 | * None. *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclDbInitNewObj( | | | | | 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 | * 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 |
︙ | ︙ | |||
1131 1132 1133 1134 1135 1136 1137 | } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewObj(void) { | | | 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 | } #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; |
︙ | ︙ | |||
1173 1174 1175 1176 1177 1178 1179 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewObj( | | | | | 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 | *---------------------------------------------------------------------- */ #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; |
︙ | ︙ | |||
1228 1229 1230 1231 1232 1233 1234 | #define OBJS_TO_ALLOC_EACH_TIME 100 void TclAllocateFreeObjects(void) { size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj)); char *basePtr; | | | | 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 | #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 ckfree() this memory, * but leaves it to Tcl's memory subsystem finalization to release it. |
︙ | ︙ | |||
1280 1281 1282 1283 1284 1285 1286 | * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclFreeObj( | | | | 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 | * *---------------------------------------------------------------------- */ #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); |
︙ | ︙ | |||
1405 1406 1407 1408 1409 1410 1411 | } } } #else /* TCL_MEM_DEBUG */ void TclFreeObj( | | | 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 | } } } #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'. */ |
︙ | ︙ | |||
1614 1615 1616 1617 1618 1619 1620 | * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetString( | | | 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 | * 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 |
︙ | ︙ | |||
1670 1671 1672 1673 1674 1675 1676 | * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetStringFromObj( | | | | 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 | * 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 |
︙ | ︙ | |||
1812 1813 1814 1815 1816 1817 1818 | * the string representation NULL to mark it invalid. * *---------------------------------------------------------------------- */ void Tcl_InvalidateStringRep( | | | 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 | * 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); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1957 1958 1959 1960 1961 1962 1963 | */ #undef Tcl_NewBooleanObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewBooleanObj( | | | | | 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 | */ #undef Tcl_NewBooleanObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewBooleanObj( int boolValue) /* Boolean used to initialize new object. */ { return Tcl_DbNewWideIntObj(boolValue!=0, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewBooleanObj( int boolValue) /* Boolean used to initialize new object. */ { Tcl_Obj *objPtr; TclNewIntObj(objPtr, boolValue!=0); return objPtr; } #endif /* TCL_MEM_DEBUG */ /* |
︙ | ︙ | |||
2007 2008 2009 2010 2011 2012 2013 | #ifndef TCL_NO_DEPRECATED #undef Tcl_DbNewBooleanObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewBooleanObj( | | | | | 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 | #ifndef TCL_NO_DEPRECATED #undef Tcl_DbNewBooleanObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewBooleanObj( int boolValue, /* Boolean used to initialize 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 = (boolValue != 0); objPtr->typePtr = &tclIntType; return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewBooleanObj( int boolValue, /* Boolean used to initialize 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_NewBooleanObj(boolValue); } |
︙ | ︙ | |||
2059 2060 2061 2062 2063 2064 2065 | * *---------------------------------------------------------------------- */ #undef Tcl_SetBooleanObj void Tcl_SetBooleanObj( | | | | 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 | * *---------------------------------------------------------------------- */ #undef Tcl_SetBooleanObj void Tcl_SetBooleanObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ int boolValue) /* Boolean used to set object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); } TclSetIntObj(objPtr, boolValue!=0); } |
︙ | ︙ | |||
2092 2093 2094 2095 2096 2097 2098 | * *---------------------------------------------------------------------- */ int Tcl_GetBooleanFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 | * *---------------------------------------------------------------------- */ 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) { *boolPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; } if (objPtr->typePtr == &tclBooleanType) { |
︙ | ︙ | |||
2158 2159 2160 2161 2162 2163 2164 | * *---------------------------------------------------------------------- */ int TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 | * *---------------------------------------------------------------------- */ 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. */ |
︙ | ︙ | |||
2204 2205 2206 2207 2208 2209 2210 | Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL); } return TCL_ERROR; } static int ParseBoolean( | | | 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 | 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]; const char *str = TclGetString(objPtr); size_t i, length = objPtr->length; if ((length == 0) || (length > 5)) { |
︙ | ︙ | |||
2346 2347 2348 2349 2350 2351 2352 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewDoubleObj Tcl_Obj * Tcl_NewDoubleObj( | | | | | 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 | */ #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 */ /* |
︙ | ︙ | |||
2394 2395 2396 2397 2398 2399 2400 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewDoubleObj( | | | | | 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 | *---------------------------------------------------------------------- */ #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); } |
︙ | ︙ | |||
2445 2446 2447 2448 2449 2450 2451 | * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetDoubleObj( | | | | 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 | * 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); } |
︙ | ︙ | |||
2478 2479 2480 2481 2482 2483 2484 | * *---------------------------------------------------------------------- */ int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 | * *---------------------------------------------------------------------- */ 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)); |
︙ | ︙ | |||
2533 2534 2535 2536 2537 2538 2539 | * *---------------------------------------------------------------------- */ static int SetDoubleFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 | * *---------------------------------------------------------------------- */ 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); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
2562 2563 2564 2565 2566 2567 2568 | * double-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfDouble( | | | 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 | * 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)); |
︙ | ︙ | |||
2608 2609 2610 2611 2612 2613 2614 | #ifndef TCL_NO_DEPRECATED #undef Tcl_NewIntObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewIntObj( | | | | | 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 | #ifndef TCL_NO_DEPRECATED #undef Tcl_NewIntObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewIntObj( int intValue) /* Int used to initialize the new object. */ { return Tcl_DbNewWideIntObj((long)intValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewIntObj( int intValue) /* Int used to initialize the new object. */ { Tcl_Obj *objPtr; TclNewIntObj(objPtr, intValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ #endif /* TCL_NO_DEPRECATED */ |
︙ | ︙ | |||
2648 2649 2650 2651 2652 2653 2654 | * *---------------------------------------------------------------------- */ #ifndef TCL_NO_DEPRECATED #undef Tcl_SetIntObj void Tcl_SetIntObj( | | | | 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 | * *---------------------------------------------------------------------- */ #ifndef TCL_NO_DEPRECATED #undef Tcl_SetIntObj void Tcl_SetIntObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ int intValue) /* Integer used to set object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); } TclSetIntObj(objPtr, intValue); } |
︙ | ︙ | |||
2688 2689 2690 2691 2692 2693 2694 | * *---------------------------------------------------------------------- */ int Tcl_GetIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 | * *---------------------------------------------------------------------- */ 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) { |
︙ | ︙ | |||
2759 2760 2761 2762 2763 2764 2765 | * int-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfInt( | | | | 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 | * 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)); } #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG) static void UpdateStringOfOldInt( 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.longValue)); } |
︙ | ︙ | |||
2817 2818 2819 2820 2821 2822 2823 | #ifndef TCL_NO_DEPRECATED #undef Tcl_NewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewLongObj( | | | | | 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 | #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 */ |
︙ | ︙ | |||
2876 2877 2878 2879 2880 2881 2882 | #ifndef TCL_NO_DEPRECATED #undef Tcl_DbNewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewLongObj( | | | | | 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 | #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); |
︙ | ︙ | |||
2932 2933 2934 2935 2936 2937 2938 | *---------------------------------------------------------------------- */ #ifndef TCL_NO_DEPRECATED #undef Tcl_SetLongObj void Tcl_SetLongObj( | | | | 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 | *---------------------------------------------------------------------- */ #ifndef TCL_NO_DEPRECATED #undef Tcl_SetLongObj void Tcl_SetLongObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ long longValue) /* Long integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetLongObj"); } TclSetIntObj(objPtr, longValue); |
︙ | ︙ | |||
2968 2969 2970 2971 2972 2973 2974 | * *---------------------------------------------------------------------- */ int Tcl_GetLongFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 | * *---------------------------------------------------------------------- */ 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; } |
︙ | ︙ | |||
3084 3085 3086 3087 3088 3089 3090 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewWideIntObj Tcl_Obj * Tcl_NewWideIntObj( | | | | | 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 | */ #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 */ |
︙ | ︙ | |||
3143 3144 3145 3146 3147 3148 3149 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewWideIntObj( | | | | | 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 | *---------------------------------------------------------------------- */ #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. */ { |
︙ | ︙ | |||
3194 3195 3196 3197 3198 3199 3200 | * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetWideIntObj( | | | | 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 | * 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"); } |
︙ | ︙ | |||
3230 3231 3232 3233 3234 3235 3236 | * *---------------------------------------------------------------------- */ int Tcl_GetWideIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 | * *---------------------------------------------------------------------- */ 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; } |
︙ | ︙ | |||
3923 3924 3925 3926 3927 3928 3929 | * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbIncrRefCount( | | | 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 | * 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 |
︙ | ︙ | |||
3986 3987 3988 3989 3990 3991 3992 | * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbDecrRefCount( | | | 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 | * 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 |
︙ | ︙ | |||
4052 4053 4054 4055 4056 4057 4058 | * None. * *---------------------------------------------------------------------- */ int Tcl_DbIsShared( | | | 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 | * 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) { |
︙ | ︙ | |||
4124 4125 4126 4127 4128 4129 4130 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitObjHashTable( | | | 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 | * 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); } |
︙ | ︙ | |||
4187 4188 4189 4190 4191 4192 4193 | 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; | | | | 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 | 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; */ |
︙ | ︙ | |||
4345 4346 4347 4348 4349 4350 4351 | *---------------------------------------------------------------------- */ Tcl_Command Tcl_GetCommandFromObj( Tcl_Interp *interp, /* The interpreter in which to resolve the * command and to report errors. */ | | | 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 | *---------------------------------------------------------------------- */ 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; |
︙ | ︙ | |||
4374 4375 4376 4377 4378 4379 4380 | * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if (objPtr->typePtr == &tclCmdNameType) { | | | | 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 | * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ resPtr = (ResolvedCmdName *)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; |
︙ | ︙ | |||
4481 4482 4483 4484 4485 4486 4487 | } } void TclSetCmdNameObj( Tcl_Interp *interp, /* Points to interpreter containing command * that should be cached in objPtr. */ | | | 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 | } } 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) { |
︙ | ︙ | |||
4521 4522 4523 4524 4525 4526 4527 | * ResolvedSymbol, which may free the Command structure. * *---------------------------------------------------------------------- */ static void FreeCmdNameInternalRep( | | | 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 | * ResolvedSymbol, which may free the Command structure. * *---------------------------------------------------------------------- */ static void FreeCmdNameInternalRep( Tcl_Obj *objPtr) /* CmdName object with internal * representation to free. */ { ResolvedCmdName *resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; /* * Decrement the reference count of the ResolvedCmdName structure. If * there are no more uses, free the ResolvedCmdName structure. |
︙ | ︙ | |||
4569 4570 4571 4572 4573 4574 4575 | * *---------------------------------------------------------------------- */ static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ | | | 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 | * *---------------------------------------------------------------------- */ static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; resPtr->refCount++; copyPtr->typePtr = &tclCmdNameType; |
︙ | ︙ | |||
4603 4604 4605 4606 4607 4608 4609 | * *---------------------------------------------------------------------- */ static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 | * *---------------------------------------------------------------------- */ 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; |
︙ | ︙ |
Changes to generic/tclParse.c.
︙ | ︙ | |||
191 192 193 194 195 196 197 | int Tcl_ParseCommand( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* First character of string containing one or * more Tcl commands. */ | | | | | 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 | int Tcl_ParseCommand( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* First character of string containing one or * more Tcl commands. */ int numBytes, /* Total number of bytes in string. If < 0, * the script consists of all bytes up to the * first null character. */ int nested, /* Non-zero means this is a nested command: * close bracket should be considered a * command terminator. If zero, then close * bracket has no special meaning. */ Tcl_Parse *parsePtr) /* Structure to fill in with information about * the parsed command; any previous * information in the structure is ignored. */ { const char *src; /* Points to current character in the * command. */ char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ int wordIndex; /* Index of word token for current word. */ int terminators; /* CHAR_TYPE bits that indicate the end of a * command. */ const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to |
︙ | ︙ | |||
616 617 618 619 620 621 622 | * *---------------------------------------------------------------------- */ static int ParseWhiteSpace( const char *src, /* First character to parse. */ | | | | | 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 | * *---------------------------------------------------------------------- */ static int ParseWhiteSpace( const char *src, /* First character to parse. */ int 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)) { |
︙ | ︙ | |||
725 726 727 728 729 730 731 | const char *src, /* First character to parse. */ int 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; | | | 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 | const char *src, /* First character to parse. */ int 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; } |
︙ | ︙ | |||
782 783 784 785 786 787 788 | int numBytes, /* Max number of bytes to scan. */ int *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. */ { | | | 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 | int numBytes, /* Max number of bytes to scan. */ int *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; int count; char buf[4] = ""; if (numBytes == 0) { if (readPtr != NULL) { |
︙ | ︙ | |||
962 963 964 965 966 967 968 | * *---------------------------------------------------------------------- */ static int ParseComment( const char *src, /* First character to parse. */ | | | | 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 | * *---------------------------------------------------------------------- */ static int ParseComment( const char *src, /* First character to parse. */ int 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) { int scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); p += scanned; numBytes -= scanned; |
︙ | ︙ | |||
1034 1035 1036 1037 1038 1039 1040 | * None. * *---------------------------------------------------------------------- */ static int ParseTokens( | | | | 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 | * None. * *---------------------------------------------------------------------- */ static int ParseTokens( const char *src, /* First character to parse. */ int 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, * TCL_SUBST_VARIABLES, and |
︙ | ︙ | |||
1313 1314 1315 1316 1317 1318 1319 | int Tcl_ParseVarName( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of variable substitution string. * First character must be "$". */ | | | | 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 | int Tcl_ParseVarName( Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of variable substitution string. * First character must be "$". */ int numBytes, /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about * the variable name. */ int append) /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ { Tcl_Token *tokenPtr; const char *src; int varIndex; unsigned array; if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } if (numBytes < 0) { |
︙ | ︙ | |||
1506 1507 1508 1509 1510 1511 1512 | * *---------------------------------------------------------------------- */ const char * Tcl_ParseVar( Tcl_Interp *interp, /* Context for looking up variable. */ | | | | 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 | * *---------------------------------------------------------------------- */ 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 = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) { TclStackFree(interp, parsePtr); return NULL; } |
︙ | ︙ | |||
1591 1592 1593 1594 1595 1596 1597 | int Tcl_ParseBraces( 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 {'. */ | | | | | 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 | int Tcl_ParseBraces( 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 {'. */ int numBytes, /* Total number of bytes in string. If < 0, * 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 append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ 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, length; if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } if (numBytes < 0) { numBytes = strlen(start); |
︙ | ︙ | |||
1733 1734 1735 1736 1737 1738 1739 | * 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. */ { | | | 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 | * 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': |
︙ | ︙ | |||
1793 1794 1795 1796 1797 1798 1799 | int Tcl_ParseQuotedString( 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 '"'. */ | | | | 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 | int Tcl_ParseQuotedString( 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 '"'. */ int numBytes, /* Total number of bytes in string. If < 0, * 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 append, /* Non-zero means append tokens to existing * information in parsePtr; zero means ignore * existing tokens in parsePtr and * reinitialize it. */ const char **termPtr) /* If non-NULL, points to word in which to |
︙ | ︙ |
Changes to generic/tclPathObj.c.
︙ | ︙ | |||
2497 2498 2499 2500 2501 2502 2503 | * Memory may be allocated. * *--------------------------------------------------------------------------- */ static void UpdateStringOfFsPath( | | | 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 | * Memory may be allocated. * *--------------------------------------------------------------------------- */ static void UpdateStringOfFsPath( Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); int cwdLen; Tcl_Obj *copy; if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { Tcl_Panic("Called UpdateStringOfFsPath with invalid object"); |
︙ | ︙ |
Changes to generic/tclPipe.c.
︙ | ︙ | |||
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.
︙ | ︙ | |||
410 411 412 413 414 415 416 | *---------------------------------------------------------------------- */ void Tcl_SetResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return value. */ | | | | 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 | *---------------------------------------------------------------------- */ void Tcl_SetResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return value. */ char *result, /* Value to be returned. If NULL, the result * is set to an empty string. */ Tcl_FreeProc *freeProc) /* Gives information about the string: * TCL_STATIC, TCL_VOLATILE, or the address of * a Tcl_FreeProc such as free. */ { Interp *iPtr = (Interp *) interp; Tcl_FreeProc *oldFreeProc = iPtr->freeProc; char *oldResult = iPtr->result; if (result == NULL) { iPtr->resultSpace[0] = 0; iPtr->result = iPtr->resultSpace; iPtr->freeProc = 0; } else if (freeProc == TCL_VOLATILE) { |
︙ | ︙ | |||
480 481 482 483 484 485 486 | * string result, then the object result is reset. * *---------------------------------------------------------------------- */ const char * Tcl_GetStringResult( | | | 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 | * string result, then the object result is reset. * *---------------------------------------------------------------------- */ const char * Tcl_GetStringResult( Tcl_Interp *interp)/* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; /* * If the string result is empty, move the object result to the string * result, then reset the object result. */ |
︙ | ︙ | |||
519 520 521 522 523 524 525 | *---------------------------------------------------------------------- */ void Tcl_SetObjResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return object value. */ | | | | | 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 | *---------------------------------------------------------------------- */ 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. |
︙ | ︙ | |||
578 579 580 581 582 583 584 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { | | | 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; #ifndef TCL_NO_DEPRECATED Tcl_Obj *objResultPtr; int length; /* * If the string result is non-empty, move the string result to the object * result, then reset the string result. |
︙ | ︙ | |||
875 876 877 878 879 880 881 | * object. * *---------------------------------------------------------------------- */ void Tcl_FreeResult( | | | | 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 | * object. * *---------------------------------------------------------------------- */ void Tcl_FreeResult( Tcl_Interp *interp)/* Interpreter for which to free result. */ { Interp *iPtr = (Interp *) interp; #ifndef TCL_NO_DEPRECATED if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { iPtr->freeProc(iPtr->result); |
︙ | ︙ | |||
914 915 916 917 918 919 920 | * It also clears any error information for the interpreter. * *---------------------------------------------------------------------- */ void Tcl_ResetResult( | | | | 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 | * 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); #ifndef TCL_NO_DEPRECATED if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); } else { |
︙ | ︙ | |||
979 980 981 982 983 984 985 | * the interpreter. * *---------------------------------------------------------------------- */ static void ResetObjResult( | | | | 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 | * 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.
︙ | ︙ | |||
5166 5167 5168 5169 5170 5171 5172 | *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestsetCmd( void *data, /* Additional flags for Get/SetVar2. */ | | | 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 | *---------------------------------------------------------------------- */ /* 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) { |
︙ | ︙ | |||
5198 5199 5200 5201 5202 5203 5204 | argv[0], " varName ?newValue?\"", NULL); return TCL_ERROR; } } static int Testset2Cmd( void *data, /* Additional flags for Get/SetVar2. */ | | | 5198 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 | 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) { |
︙ | ︙ | |||
5249 5250 5251 5252 5253 5254 5255 | *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestsaveresultCmd( void *dummy, /* Not used. */ | | | 5249 5250 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 | *---------------------------------------------------------------------- */ /* 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. */ { Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; |
︙ | ︙ | |||
5380 5381 5382 5383 5384 5385 5386 | * *---------------------------------------------------------------------- */ static int TestmainthreadCmd( void *dummy, /* Not used. */ | | | 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 | * *---------------------------------------------------------------------- */ 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); |
︙ | ︙ | |||
5441 5442 5443 5444 5445 5446 5447 | * *---------------------------------------------------------------------- */ static int TestsetmainloopCmd( void *dummy, /* Not used. */ | | | 5441 5442 5443 5444 5445 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 | * *---------------------------------------------------------------------- */ 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; } |
︙ | ︙ | |||
5470 5471 5472 5473 5474 5475 5476 | * *---------------------------------------------------------------------- */ static int TestexitmainloopCmd( void *dummy, /* Not used. */ | | | 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 | * *---------------------------------------------------------------------- */ 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(void *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(void *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); ckfree(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 = (String *)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 = (String *)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 = (Cache*)arg; Cache **nextPtrPtr; | | | 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 | void TclFreeAllocCache( void *arg) { Cache *cachePtr = (Cache*)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 | char * TclpAlloc( unsigned int reqSize) { Cache *cachePtr; Block *blockPtr; | | | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 | char * TclpAlloc( unsigned int reqSize) { Cache *cachePtr; Block *blockPtr; int bucket; size_t size; #ifndef __LP64__ if (sizeof(int) >= sizeof(size_t)) { /* An unsigned int overflow can also be a size_t overflow */ const size_t zero = 0; const size_t max = ~zero; |
︙ | ︙ | |||
533 534 535 536 537 538 539 | * *---------------------------------------------------------------------- */ Tcl_Obj * TclThreadAllocObj(void) { | | | | | 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 | * *---------------------------------------------------------------------- */ 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; } |
︙ | ︙ | |||
705 706 707 708 709 710 711 | static void MoveObjs( Cache *fromPtr, Cache *toPtr, int numMove) { | | | 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 | 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 |
︙ | ︙ | |||
806 807 808 809 810 811 812 | static char * Block2Ptr( Block *blockPtr, int bucket, unsigned int reqSize) { | | | | 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 | 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 |
︙ | ︙ | |||
956 957 958 959 960 961 962 | */ static int GetBlocks( Cache *cachePtr, int bucket) { | | | | 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 | */ static int GetBlocks( Cache *cachePtr, int bucket) { Block *blockPtr; int 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. */ |
︙ | ︙ | |||
1002 1003 1004 1005 1006 1007 1008 | blockPtr->nextBlock = NULL; } } UnlockBucket(cachePtr, bucket); } if (cachePtr->buckets[bucket].numFree == 0) { | | | 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 | 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 = (ThreadSpecificData *)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 = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { TimerHandler *timerHandlerPtr; timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; while (timerHandlerPtr != NULL) { tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; ckfree(timerHandlerPtr); timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; } |
︙ | ︙ | |||
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 = (IdleHandler *)ckalloc(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 { |
︙ | ︙ | |||
1045 1046 1047 1048 1049 1050 1051 | 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; | | | 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 | 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; } |
︙ | ︙ | |||
1173 1174 1175 1176 1177 1178 1179 | 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. */ { | | | 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 | 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, |
︙ | ︙ | |||
1668 1669 1670 1671 1672 1673 1674 | * *---------------------------------------------------------------------- */ static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ | | | | 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 | * *---------------------------------------------------------------------- */ 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. */ int 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; /* |
︙ | ︙ | |||
1916 1917 1918 1919 1920 1921 1922 | * string in startLevel and startCmd so that we can delete this * interpreter trace when it reaches the end of this proc. */ if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL) && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) { | | | 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 | * string in startLevel and startCmd so that we can delete this * interpreter trace when it reaches the end of this proc. */ if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL) && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) { unsigned len = strlen(command) + 1; tcmdPtr->startLevel = level; tcmdPtr->startCmd = (char *)ckalloc(len); memcpy(tcmdPtr->startCmd, command, len); tcmdPtr->refCount++; tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0, (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2, |
︙ | ︙ | |||
2061 2062 2063 2064 2065 2066 2067 | Tcl_IncrRefCount(errMsgObj); result = (char *) errMsgObj; } Tcl_DStringFree(&cmd); } } if (destroy && result != NULL) { | | | 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 | 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; } |
︙ | ︙ | |||
2138 2139 2140 2141 2142 2143 2144 | 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 */ { | | | | 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 | 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) { |
︙ | ︙ | |||
2338 2339 2340 2341 2342 2343 2344 | 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; | | | 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 | 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. */ |
︙ | ︙ | |||
2530 2531 2532 2533 2534 2535 2536 | * *---------------------------------------------------------------------- */ int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ | | | 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 | * *---------------------------------------------------------------------- */ 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 |
︙ | ︙ | |||
2564 2565 2566 2567 2568 2569 2570 | return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg); } int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ | | | 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 | 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 |
︙ | ︙ | |||
3242 3243 3244 3245 3246 3247 3248 | 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. */ | | | 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 | 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 ckfree()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.
︙ | ︙ | |||
357 358 359 360 361 362 363 | 0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014, 0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178 }; #undef Tcl_UtfToUniChar int Tcl_UtfToUniChar( | | | | 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 | 0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014, 0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178 }; #undef Tcl_UtfToUniChar int Tcl_UtfToUniChar( const char *src, /* The UTF-8 string. */ int *chPtr)/* Filled with the unsigned int represented by * the UTF-8 string. */ { int byte; /* * Unroll 1 to 4 byte UTF-8 sequences. */ |
︙ | ︙ | |||
714 715 716 717 718 719 720 | * None. * *--------------------------------------------------------------------------- */ int Tcl_NumUtfChars( | | | | | 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 | * None. * *--------------------------------------------------------------------------- */ int Tcl_NumUtfChars( const char *src, /* The UTF-8 string to measure. */ int length) /* The length of the string in bytes, or -1 * for strlen(string). */ { Tcl_UniChar ch = 0; int 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 < 0) { while (*src != '\0') { src += TclUtfToUniChar(src, &ch); i++; } if (i < 0) i = INT_MAX; /* Bug [2738427] */ } 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)) { |
︙ | ︙ | |||
951 952 953 954 955 956 957 | * None. * *--------------------------------------------------------------------------- */ int Tcl_UniCharAtIndex( | | | | 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 | * None. * *--------------------------------------------------------------------------- */ int Tcl_UniCharAtIndex( const char *src, /* The UTF-8 string to dereference. */ int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int fullchar = 0; #if TCL_UTF_MAX <= 4 int len = 0; #endif |
︙ | ︙ | |||
999 1000 1001 1002 1003 1004 1005 | * None. * *--------------------------------------------------------------------------- */ const char * Tcl_UtfAtIndex( | | | | 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 | * None. * *--------------------------------------------------------------------------- */ const char * Tcl_UtfAtIndex( const char *src, /* The UTF-8 string. */ int index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int len = 0; while (index-- > 0) { len = TclUtfToUniChar(src, &ch); src += len; |
︙ | ︙ | |||
1306 1307 1308 1309 1310 1311 1312 | { /* * 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. */ | | | 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 | { /* * 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.
︙ | ︙ | |||
939 940 941 942 943 944 945 | * None. * *---------------------------------------------------------------------- */ int Tcl_ScanElement( | | | | 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 | * None. * *---------------------------------------------------------------------- */ int Tcl_ScanElement( const char *src, /* String to convert to list element. */ int *flagPtr) /* Where to store information to guide * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1319 1320 1321 1322 1323 1324 1325 | * None. * *---------------------------------------------------------------------- */ int Tcl_ConvertElement( | | | | | 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 | * None. * *---------------------------------------------------------------------- */ int Tcl_ConvertElement( const char *src, /* Source information for list element. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1349 1350 1351 1352 1353 1354 1355 | * None. * *---------------------------------------------------------------------- */ int Tcl_ConvertCountedElement( | | | 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 | * None. * *---------------------------------------------------------------------- */ int Tcl_ConvertCountedElement( const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { int numBytes = TclConvertElement(src, length, dst, flags); dst[numBytes] = '\0'; return numBytes; |
︙ | ︙ | |||
1382 1383 1384 1385 1386 1387 1388 | * None. * *---------------------------------------------------------------------- */ int TclConvertElement( | | | 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 | * None. * *---------------------------------------------------------------------- */ int TclConvertElement( const char *src, /* Source information for list element. */ int 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; |
︙ | ︙ | |||
4188 4189 4190 4191 4192 4193 4194 | int TclCheckBadOctal( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ const char *value) /* String to check. */ { | | | 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 | int TclCheckBadOctal( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ const char *value) /* String to check. */ { const char *p = value; /* * A frequent mistake is invalid octal values due to an unwanted leading * zero. Try to generate a meaningful error message. */ while (TclIsSpaceProc(*p)) { |
︙ | ︙ |
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; |
︙ | ︙ | |||
980 981 982 983 984 985 986 | if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; int localLen; for (i=0 ; i<localCt ; i++, objPtrPtr++) { | | | 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 | if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; int 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; |
︙ | ︙ | |||
1321 1322 1323 1324 1325 1326 1327 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjGetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ | | | | 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 | *---------------------------------------------------------------------- */ 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; |
︙ | ︙ | |||
1419 1420 1421 1422 1423 1424 1425 | *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrGetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ | | | 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 | *---------------------------------------------------------------------- */ 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 |
︙ | ︙ | |||
1525 1526 1527 1528 1529 1530 1531 | *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_SetObjCmd( ClientData dummy, /* Not used. */ | | | 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 | *---------------------------------------------------------------------- */ /* 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); |
︙ | ︙ | |||
1749 1750 1751 1752 1753 1754 1755 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjSetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ | | | | 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 | *---------------------------------------------------------------------- */ 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. */ |
︙ | ︙ | |||
1989 1990 1991 1992 1993 1994 1995 | *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrSetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ | | | 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 | *---------------------------------------------------------------------- */ 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 |
︙ | ︙ | |||
2309 2310 2311 2312 2313 2314 2315 | * 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. */ { | | | 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 | * 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)) { |
︙ | ︙ | |||
2570 2571 2572 2573 2574 2575 2576 | *---------------------------------------------------------------------- */ int TclPtrUnsetVarIdx( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ | | | 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 | *---------------------------------------------------------------------- */ 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 |
︙ | ︙ | |||
2824 2825 2826 2827 2828 2829 2830 | int Tcl_UnsetObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 | 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. */ |
︙ | ︙ | |||
2893 2894 2895 2896 2897 2898 2899 | 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; | | | 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 | 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; } |
︙ | ︙ | |||
4949 4950 4951 4952 4953 4954 4955 | 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; | | | 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 | 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; } |
︙ | ︙ | |||
5009 5010 5011 5012 5013 5014 5015 | 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; | | | | 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 | 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)) { |
︙ | ︙ | |||
5406 5407 5408 5409 5410 5411 5412 | * *---------------------------------------------------------------------- */ static void DeleteSearches( Interp *iPtr, | | | 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 | * *---------------------------------------------------------------------- */ 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); |
︙ | ︙ | |||
5548 5549 5550 5551 5552 5553 5554 | 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; | | | 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 | 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. */ |
︙ | ︙ | |||
5600 5601 5602 5603 5604 5605 5606 | void TclDeleteCompiledLocalVars( Interp *iPtr, /* Interpreter to which variables belong. */ CallFrame *framePtr) /* Procedure call frame containing compiler- * assigned local variables to delete. */ { | | | 5600 5601 5602 5603 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 | 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++) { |
︙ | ︙ | |||
5649 5650 5651 5652 5653 5654 5655 | 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; | | | 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 | 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)) { |
︙ | ︙ | |||
5838 5839 5840 5841 5842 5843 5844 | * Tcl_Obj), or NULL if it is a scalar variable */ static void FreeParsedVarName( Tcl_Obj *objPtr) { | | | | 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 | * 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); } |
︙ | ︙ | |||
5944 5945 5946 5947 5948 5949 5950 | * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; ResolverScheme *resPtr; Namespace *nsPtr[2], *cxtNsPtr; const char *simpleName; Var *varPtr; | | | 5944 5945 5946 5947 5948 5949 5950 5951 5952 5953 5954 5955 5956 5957 5958 | * 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 |
︙ | ︙ | |||
6596 6597 6598 6599 6600 6601 6602 | 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; | | | | 6596 6597 6598 6599 6600 6601 6602 6603 6604 6605 6606 6607 6608 6609 6610 6611 | 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; int 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 macosx/tclMacOSXFCmd.c.
︙ | ︙ | |||
343 344 345 346 347 348 349 | * Construct path to resource fork. */ Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, native, -1); Tcl_DStringAppend(&ds, _PATH_RSRCFORKSPEC, -1); | | | 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 | * Construct path to resource fork. */ Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, native, -1); Tcl_DStringAppend(&ds, _PATH_RSRCFORKSPEC, -1); result = truncate(Tcl_DStringValue(&ds), 0); if (result != 0) { /* * truncate() on a valid resource fork path may fail with a * permission error in some OS releases, try truncating with * open() instead: */ |
︙ | ︙ | |||
685 686 687 688 689 690 691 | * OSType-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfOSType( | | | 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 | * OSType-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfOSType( Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { const int size = TCL_UTF_MAX * 4; char *dst = Tcl_InitStringRep(objPtr, NULL, size); OSType osType = (OSType) objPtr->internalRep.wideValue; int written = 0; Tcl_Encoding encoding; |
︙ | ︙ |
Changes to tests/chanio.test.
︙ | ︙ | |||
39 40 41 42 43 44 45 46 47 48 49 50 51 52 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] # You need a *very* special environment to do some tests. In particular, # many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 if "umask" cannot be run, the # tests will be skipped. | > | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # You need a *very* special environment to do some tests. In particular, # many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 if "umask" cannot be run, the # tests will be skipped. |
︙ | ︙ | |||
2786 2787 2788 2789 2790 2791 2792 | variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { for {set i 0} {$i < 2000} {incr i} { chan puts $s $l } } | | | 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 | variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { for {set i 0} {$i < 2000} {incr i} { chan puts $s $l } } } -constraints {socket tempNotMac fileevent knownMsvcBug} -body { proc accept {s a p} { variable x chan event $s readable [namespace code [list readit $s]] chan configure $s -blocking off set x accepted } proc readit {s} { |
︙ | ︙ |
Changes to tests/io.test.
︙ | ︙ | |||
39 40 41 42 43 44 45 46 47 48 49 50 51 52 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testobj [llength [info commands testobj]] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. | > | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] testConstraint openpipe 1 testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testobj [llength [info commands testobj]] testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}] # some tests can only be run is umask is 2 # if "umask" cannot be run, the tests will be skipped. |
︙ | ︙ | |||
2224 2225 2226 2227 2228 2229 2230 | close $f lappend l [file size $path(test1)] set l } {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ | | | 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 | close $f lappend l [file size $path(test1)] set l } {0 60 72} set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ {stdio asyncPipeClose openpipe knownMsvcBug} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f { |
︙ | ︙ | |||
2828 2829 2830 2831 2832 2833 2834 | # allow a little time for the background process to close. # otherwise, the following test fails on the [file delete $path(output) # on Windows because a process still has the file open. after 100 set v 1; vwait v set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ | | | 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 | # allow a little time for the background process to close. # otherwise, the following test fails on the [file delete $path(output) # on Windows because a process still has the file open. after 100 set v 1; vwait v set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ {stdio asyncPipeClose openpipe knownMsvcBug} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] puts $f "set f \[[list open $path(output) w]]" puts $f {fconfigure $f -translation lf} |
︙ | ︙ |
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 |
︙ | ︙ |
Changes to win/rules.vc.
︙ | ︙ | |||
684 685 686 687 688 689 690 | # UNCHECKED - 1 -> when doing a debug build with symbols, use the release # C runtime, 0 -> use the debug C runtime. # USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking # CONFIG_CHECK - 1 -> check current build configuration against Tcl # configuration (ignored for Tcl itself) # _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build # (CRT library should support this) | | | 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 | # UNCHECKED - 1 -> when doing a debug build with symbols, use the release # C runtime, 0 -> use the debug C runtime. # USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking # CONFIG_CHECK - 1 -> check current build configuration against Tcl # configuration (ignored for Tcl itself) # _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build # (CRT library should support this) # TCL_UTF_MAX=6 - forces a build using 32-bit Tcl_UniChar in stead of 16-bit. # Further, LINKERFLAGS are modified based on above. # Default values for all the above STATIC_BUILD = 0 TCL_THREADS = 1 DEBUG = 0 SYMBOLS = 0 |
︙ | ︙ | |||
751 752 753 754 755 756 757 | !if [nmakehlp -f $(OPTS) "time64bit"] !message *** Force 64-bit time_t _USE_64BIT_TIME_T = 1 !endif !if [nmakehlp -f $(OPTS) "utfmax"] !message *** Force 32-bit Tcl_UniChar | | | 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 | !if [nmakehlp -f $(OPTS) "time64bit"] !message *** Force 64-bit time_t _USE_64BIT_TIME_T = 1 !endif !if [nmakehlp -f $(OPTS) "utfmax"] !message *** Force 32-bit Tcl_UniChar TCL_UTF_MAX = 6 !endif # Yes, it's weird that the "symbols" option controls DEBUG and # the "pdbs" option controls SYMBOLS. That's historical. !if [nmakehlp -f $(OPTS) "symbols"] !message *** Doing symbols DEBUG = 1 |
︙ | ︙ | |||
1317 1318 1319 1320 1321 1322 1323 | !if $(VCVERSION) < 1300 OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64 !endif !if "$(_USE_64BIT_TIME_T)" == "1" OPTDEFINES = $(OPTDEFINES) -D_USE_64BIT_TIME_T !endif | | | | 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 | !if $(VCVERSION) < 1300 OPTDEFINES = $(OPTDEFINES) -DNO_STRTOI64 !endif !if "$(_USE_64BIT_TIME_T)" == "1" OPTDEFINES = $(OPTDEFINES) -D_USE_64BIT_TIME_T !endif !if "$(TCL_UTF_MAX)" == "6" OPTDEFINES = $(OPTDEFINES) -DTCL_UTF_MAX=6 !endif # _ATL_XP_TARGETING - Newer SDK's need this to build for XP COMPILERFLAGS = /D_ATL_XP_TARGETING # Following is primarily for the benefit of extensions. Tcl 8.5 builds # Tcl without /DUNICODE, while 8.6 builds with it defined. When building |
︙ | ︙ |