-- cgit v0.12 From 8d6d474bd781633a74be0ee1e52e87f6c34186c7 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 4 Apr 2024 23:01:20 +0000 Subject: dup test names --- tests/clock.test | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index b3510fa..8bb11b4 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18704,25 +18704,25 @@ test clock-6.10 {input of seconds - overflow} { } {1 {integer value too large to represent} {CLOCK dateTooLarge}} foreach sign {{} -} { - test clock-6.10a {input of seconds - overflow, bug [1f40aa83c5]} { + test clock-6.10a$sign {input of seconds - overflow, bug [1f40aa83c5]} { list [catch {clock scan ${sign}27670116110564327423 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] } {1 {integer value too large to represent} {CLOCK dateTooLarge}} - test clock-6.10b {input of seconds - overflow, bug [1f40aa83c5]} { + test clock-6.10b$sign {input of seconds - overflow, bug [1f40aa83c5]} { list [catch {clock scan ${sign}27670116110564327424 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] } {1 {integer value too large to represent} {CLOCK dateTooLarge}} - test clock-6.10c {input of seconds - no overflow, bug [1f40aa83c5]} { + test clock-6.10c$sign {input of seconds - no overflow, bug [1f40aa83c5]} { list [catch {clock scan ${sign}[string repeat 9 18] -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] } [list 0 ${sign}[string repeat 9 18] {}] - test clock-6.10d {input of seconds - overflow, bug [1f40aa83c5]} { + test clock-6.10d$sign {input of seconds - overflow, bug [1f40aa83c5]} { list [catch {clock scan ${sign}[string repeat 9 19] -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] } {1 {integer value too large to represent} {CLOCK dateTooLarge}} # both fololowing freescan test don't generate overflow error, # since it is a free scan, thus the token is simply not recognized further in yacc lexer, # therefore we get parse error (can be surely changed latter): - test clock-6.10e {input of seconds - overflow (but since freescan parse error, but not boom), bug [1f40aa83c5]} -body { + test clock-6.10e$sign {input of seconds - overflow (but since freescan parse error, but not boom), bug [1f40aa83c5]} -body { list [catch {clock scan ${sign}27670116110564327423 -gmt true} result opt] $result [dict getd $opt -errorcode ""] } -match glob -result {1 {unable to convert date-time string "*": syntax error *} {TCL VALUE DATE PARSE}} - test clock-6.10f {input of seconds - overflow (but since freescan parse error, but not boom), bug [1f40aa83c5]} -body { + test clock-6.10f$sign {input of seconds - overflow (but since freescan parse error, but not boom), bug [1f40aa83c5]} -body { list [catch {clock scan ${sign}27670116110564327424 -gmt true} result opt] $result [dict getd $opt -errorcode ""] } -match glob -result {1 {unable to convert date-time string "*": syntax error *} {TCL VALUE DATE PARSE}} }; unset sign @@ -18840,7 +18840,7 @@ test clock-6.21.0.1 {Stardate 0.1 - 1.9 (test negative clock value -> positive S test clock-6.21.0.2 {Stardate 10000.1 - 10002.9 (test negative clock value -> positive Stardate)} { _testStarDates [clock scan "Stardate 10000.1" -f %Q -g 1] 3 0.1 } {} -test clock-6.21.0.2 {Stardate 80000.1 - 80002.9 (test positive clock value)} { +test clock-6.21.0.3 {Stardate 80000.1 - 80002.9 (test positive clock value)} { _testStarDates [clock scan "Stardate 80001.1" -f %Q -g 1] 3 0.1 } {} test clock-6.21.1 {Stardate} { @@ -18907,7 +18907,7 @@ test clock-6.22.16 {Greedy match} { test clock-6.22.17 {Greedy match} { clock format [clock scan "111213120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1 } {Tue Dec 13 01:02:00 GMT 2011} -test clock-6.22.17 {Greedy match (space wins as date-time separator)} { +test clock-6.22.17.1 {Greedy match (space wins as date-time separator)} { clock format [clock scan "1112 13120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1 } {Sun Jan 02 13:12:00 GMT 2011} test clock-6.22.18 {Greedy match (second space wins as date-time separator)} { -- cgit v0.12 From 8f9afd35d38fa76e02ae2cbd4e45af5f0e15b295 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 5 Apr 2024 15:39:13 +0000 Subject: Delete the changes file pending decisions about TIP 693 --- changes | 9596 --------------------------------------------------------------- 1 file changed, 9596 deletions(-) delete mode 100644 changes diff --git a/changes b/changes deleted file mode 100644 index 2ae1df1..0000000 --- a/changes +++ /dev/null @@ -1,9596 +0,0 @@ -Recent user-visible changes to Tcl: - -1. No more [command1] [command2] construct for grouping multiple -commands on a single command line. - -2. Semi-colon now available for grouping commands on a line. - -3. For a command to span multiple lines, must now use backslash-return -at the end of each line but the last. - -4. "Var" command has been changed to "set". - -5. Double-quotes now available as an argument grouping character. - -6. "Return" may be used at top-level. - -7. More backslash sequences available now. In particular, backslash-newline -may be used to join lines in command files. - -8. New or modified built-in commands: case, return, for, glob, info, -print, return, set, source, string, uplevel. - -9. After an error, the variable "errorInfo" is filled with a stack -trace showing what was being executed when the error occurred. - -10. Command abbreviations are accepted when parsing commands, but -are not recommended except for purely-interactive commands. - -11. $, set, and expr all complain now if a non-existent variable is -referenced. - -12. History facilities exist now. See Tcl.man and Tcl_RecordAndEval.man. - -13. Changed to distinguish between empty variables and those that don't -exist at all. Interfaces to Tcl_GetVar and Tcl_ParseVar have changed -(NULL return value is now possible). *** POTENTIAL INCOMPATIBILITY *** - -14. Changed meaning of "level" argument to "uplevel" command (1 now means -"go up one level", not "go to level 1"; "#1" means "go to level 1"). -*** POTENTIAL INCOMPATIBILITY *** - -15. 3/19/90 Added "info exists" option to see if variable exists. - -16. 3/19/90 Added "noAbbrev" variable to prohibit command abbreviations. - -17. 3/19/90 Added extra errorInfo option to "error" command. - -18. 3/21/90 Double-quotes now only affect space: command, variable, -and backslash substitutions still occur inside double-quotes. -*** POTENTIAL INCOMPATIBILITY *** - -19. 3/21/90 Added support for \r. - -20. 3/21/90 List, concat, eval, and glob commands all expect at least -one argument now. *** POTENTIAL INCOMPATIBILITY *** - -21. 3/22/90 Added "?:" operators to expressions. - -22. 3/25/90 Fixed bug in Tcl_Result that caused memory to get trashed. - -------------------- Released version 3.1 --------------------- - -23. 3/29/90 Fixed bug that caused "file a.b/c ext" to return ".b/c". - -24. 3/29/90 Semi-colon is not treated specially when enclosed in -double-quotes. - -------------------- Released version 3.2 --------------------- - -25. 4/16/90 Rewrote "exec" not to use select or signals anymore. -Should be more Sys-V compatible, and no slower in the normal case. - -26. 4/18/90 Rewrote "glob" to eliminate GNU code (there's no GNU code -left in Tcl, now), and added Tcl_TildeSubst procedure. Added automatic -tilde-substitution in many commands, including "glob". - -------------------- Released version 3.3 --------------------- - -27. 7/11/90 Added "Tcl_AppendResult" procedure. - -28. 7/20/90 "History" with no options now defaults to "history info" -rather than to "history redo". Although this is a backward incompatibility, -it should only be used interactively and thus shouldn't present any -compatibility problems with scripts. - -29. 7/20/90 Added "Tcl_GetInteger", "Tcl_GetDouble", and "Tcl_GetBoolean" -procedures. - -30. 7/22/90 Removed "Tcl_WatchInterp" procedure: doesn't seem to be -necessary, since the same effect can be achieved with the deletion -callbacks on individual commands. *** POTENTIAL INCOMPATIBILITY *** - -31. 7/23/90 Added variable tracing: Tcl_TraceVar, Tcl_UnTraceVar, -and Tcl_VarTraceInfo procedures, "trace" command. - -32. 8/9/90 Mailed out list of all bug fixes since 3.3 release. - -33. 8/29/90 Fixed bugs in Tcl_Merge relating to backslashes and -semi-colons. Mailed out patch. - -34. 9/3/90 Fixed bug in tclBasic.c: quotes weren't quoting ]'s. -Mailed out patch. - -35. 9/19/90 Rewrote exec to always use files both for input and -output to the process. The old pipe-based version didn't work if -the exec'ed process forked a child and then exited: Tcl waited -around for stdout to get closed, which didn't happen until the -grandchild exited. - -36. 11/5/90 ERR_IN_PROGRESS flag wasn't being cleared soon enough -in Tcl_Eval, allowing error messages from different commands to -pile up in $errorInfo. Fixed by re-arranging code in Tcl_Eval that -re-initializes result and ERR_IN_PROGRESS flag. Didn't mail out -patch: changes too complicated to describe. - -37. 12/19/90 Added Tcl_VarEval procedure as a convenience for -assembling and executing Tcl commands. - -38. 1/29/91 Fixed core leak in Tcl_AddErrorInfo. Also changed procedure -and Tcl_Eval so that first call to Tcl_AddErrorInfo need not come from -Tcl_Eval. - ------------------ Released version 5.0 with Tk ------------------ - -39. 4/3/91 Removed change bars from manual entries, leaving only those -that came after version 3.3 was released. - -40. 5/17/91 Changed tests to conform to Mary Ann May-Pumphrey's approach. - -41. 5/23/91 Massive revision to Tcl parser to simplify the implementation -of string and floating-point support in expressions. Newlines inside -[] are now treated as command separators rather than word separators -(this makes newline treatment consistent throughout Tcl). -*** POTENTIAL INCOMPATIBILITY *** - -42. 5/23/91 Massive rewrite of expression code to support floating-point -values and simple string comparisons. The C interfaces to expression -routines have changed (Tcl_Expr is replaced by Tcl_ExprLong, Tcl_ExprDouble, -etc.), but all old Tcl expression strings should be accepted by the new -expression code. -*** POTENTIAL INCOMPATIBILITY *** - -43. 5/23/91 Modified tclHistory.c to check for negative "keep" value. - -44. 5/23/91 Modified Tcl_Backslash to handle backslash-newline. It now -returns 0 to indicate that a backslash sequence should be replaced by -no character at all. -*** POTENTIAL INCOMPATIBILITY *** - -45. 5/29/91 Modified to use ANSI C function prototypes. Must set -"USE_ANSI" switch when compiling to get prototypes. - -46. 5/29/91 Completed test suite by providing tests for all of the -built-in Tcl commands. - -47. 5/29/91 Changed Tcl_Concat to eliminate leading and trailing -white-space in each of the things it concatenates and to ignore -elements that are empty or have only white space in them. This -produces cleaner output from the "concat" command. -*** POTENTIAL INCOMPATIBILITY *** - -48. 5/31/91 Changed "set" command and Tcl_SetVar procedure to return -new value of variable. - -49. 6/1/91 Added "while" and "cd" commands. - -50. 6/1/91 Changed "exec" to delete the last character of program -output if it is a newline. In most cases this makes it easier to -process program-generated output. -*** POTENTIAL INCOMPATIBILITY *** - -51. 6/1/91 Made sure that pointers are never used after freeing them. - -52. 6/1/91 Fixed bug in TclWordEnd where it wasn't dealing with -[] inside quotes correctly. - -53. 6/8/91 Fixed exec.test to accept return values of either 1 or -255 from "false" command. - -54. 7/6/91 Massive overhaul of variable management. Associative -arrays now available, along with "unset" command (and Tcl_UnsetVar -procedure). Variable traces have been completely reworked: -interfaces different both from Tcl and C, and multiple traces may -exist on same variable. Can no longer redefine existing local -variable to be global. Calling sequences have changed slightly -for Tcl_GetVar and Tcl_SetVar ("global" is now "flags"). Tcl_SetVar -can fail and return a NULL result. New forms of variable-manipulation -procedures: Tcl_GetVar2, Tcl_SetVar2, etc. Syntax of variable -$-notation changed to support array indexing. -*** POTENTIAL INCOMPATIBILITY *** - -55. 7/6/91 Added new list-manipulation procedures: Tcl_ScanElement, -Tcl_ConvertElement, Tcl_AppendElement. - -56. 7/12/91 Created new procedure Tcl_EvalFile, which does most of the -work of the "source" command. - -57. 7/20/91 Major reworking of "exec" command to allow pipelines, -more redirection, background. Added new procedures Tcl_Fork, -Tcl_WaitPids, Tcl_DetachPids, and Tcl_CreatePipeline. The old -"< input" notation has been replaced by "<< input" ("<" is for -redirection from a file). Also handles error returns and abnormal -terminations (e.g. signals) differently. -*** POTENTIAL INCOMPATIBILITY *** - -58. 7/21/91 Added "append" and "lappend" commands. - -59. 7/22/91 Reworked error messages and manual entries to use -?x? as the notation for an optional argument x, instead of [x]. The -bracket notation was often confused with the use of brackets for -command substitution. Also modified error messages to be more -consistent. - -60. 7/23/91 Tcl_DeleteCommand now returns an indication of whether -or not the command actually existed, and the "rename" command uses -this information to return an error if an attempt is made to delete -a non-existent command. -*** POTENTIAL INCOMPATIBILITY *** - -61. 7/25/91 Added new "errorCode" mechanism, along with procedures -Tcl_SetErrorCode, Tcl_UnixError, and Tcl_ResetResult. Renamed -Tcl_Return to Tcl_SetResult, but left a #define for Tcl_Return to -avoid compatibility problems. - -62. 7/26/91 Extended "case" command with alternate syntax where all -patterns and commands are together in a single list argument: makes -it easier to write multi-line case statements. - -63. 7/27/91 Changed "print" command to perform tilde-substitution on -the file name. - -64. 7/27/91 Added "tolower", "toupper", "trim", "trimleft", and "trimright" -options to "string" command. - -65. 7/29/91 Added "atime", "mtime", "size", and "stat" options to "file" -command. - -66. 8/1/91 Added "split" and "join" commands. - -67. 8/11/91 Added commands for file I/O, including "open", "close", -"read", "gets", "puts", "flush", "eof", "seek", and "tell". - -68. 8/14/91 Switched to use a hash table for command lookups. Command -abbreviations no longer have direct support in the Tcl interpreter, but -it should be possible to simulate them with the auto-load features -described below. The "noAbbrev" variable is no longer used by Tcl. -*** POTENTIAL INCOMPATIBILITY *** - -68.5 8/15/91 Added support for "unknown" command, which can be used to -complete abbreviations, auto-load library files, auto-exec shell -commands, etc. - -69. 8/15/91 Added -nocomplain switch to "glob" command. - -70. 8/20/91 Added "info library" option and TCL_LIBRARY #define. Also -added "info script" option. - -71. 8/20/91 Changed "file" command to take "option" argument as first -argument (before file name), for consistency with other Tcl commands. -*** POTENTIAL INCOMPATIBILITY *** - -72. 8/20/91 Changed format of information in $errorInfo variable: -comments such as - ("while" body line 1) -are now on separate lines from commands being executed. -*** POTENTIAL INCOMPATIBILITY *** - -73. 8/20/91 Changed Tcl_AppendResult so that it (eventually) frees -large buffers that it allocates. - -74. 8/21/91 Added "linsert", "lreplace", "lsearch", and "lsort" -commands. - -75. 8/28/91 Added "incr" and "exit" commands. - -76. 8/30/91 Added "regexp" and "regsub" commands. - -77. 9/4/91 Changed "dynamic" field in interpreters to "freeProc" (procedure -address). This allows for alternative storage managers. -*** POTENTIAL INCOMPATIBILITY *** - -78. 9/6/91 Added "index", "length", and "range" options to "string" -command. Added "lindex", "llength", and "lrange" commands. - -79. 9/8/91 Removed "index", "length", "print" and "range" commands. -"Print" is redundant with "puts", but less general, and the other -commands are replaced with the new commands described in change 78 -above. -*** POTENTIAL INCOMPATIBILITY *** - -80. 9/8/91 Changed history revision to occur even when history command -is nested; needed in order to allow "history" to be invoked from -"unknown" procedure. - -81. 9/13/91 Changed "panic" not to use vfprintf (it's uglier and less -general now, but makes it easier to run Tcl on systems that don't -have vfprintf). Also changed "strerror" not to redeclare sys_errlist. - -82. 9/19/91 Lots of changes to improve portability to different UNIX -systems, including addition of "config" script to adapt Tcl to the -configuration of the system it's being compiled on. - -83. 9/22/91 Added "pwd" command. - -84. 9/22/91 Renamed manual pages so that their filenames are no more -than 14 characters in length, moved to "doc" subdirectory. - -85. 9/24/91 Redid manual entries so they contain the supplemental -macros that they need; can just print with "troff -man" or "man" -now. - -86. 9/26/91 Created initial version of script library, including -a version of "unknown" that does auto-loading, auto-execution, and -abbreviation expansion. This library is used by tclTest -automatically. See the "library" manual entry for details. - ------------------ Released version 6.0, 9/26/91 ------------------ - -87. 9/30/91 Made "string tolower" and "string toupper" check case -before converting: on some systems, "tolower" and "toupper" assume -that character already has particular case. - -88. 9/30/91 Fixed bug in Tcl_SetResult: wasn't always setting freeProc -correctly when called with NULL value. This tended to cause memory -allocation errors later. - -89. 10/3/91 Added "upvar" command. - -90. 10/4/91 Changed "format" so that internally it converts %D to %ld, -%U to %lu, %O to %lo, and %F to %f. This eliminates some compatibility -problems on some machines without affecting behavior. - -91. 10/10/91 Fixed bug in "regsub" that caused core dumps with the -all -option when the last match wasn't at the end of the string. - -92. 10/17/91 Fixed problems with backslash sequences: \r support was -incomplete and \f and \v weren't supported at all. - -93. 10/24/91 Added Tcl_InitHistory procedure. - -94. 10/24/91 Changed "regexp" to store "-1 -1" in subMatchVars that -don't match, rather than returning an error. - -95. 10/27/91 Modified "regexp" to return actual strings in matchVar -and subMatchVars instead of indices. Added "-indices" switch to cause -indices to be returned. -*** POTENTIAL INCOMPATIBILITY *** - -96. 10/27/91 Fixed bug in "scan" where it used hardwired constants for -sizes of floats and doubles instead of using "sizeof". - -97. 10/31/91 Fixed bug in tclParse.c where parse-related error messages -weren't being storage-managed correctly, causing spurious free's. - -98. 10/31/91 Form feed and vertical tab characters are now considered -to be space characters by the parser. - -99. 10/31/91 Added TCL_LEAVE_ERR_MSG flag to procedures like Tcl_SetVar. - -100. 11/7/91 Fixed bug in "case" where "in" argument couldn't be omitted -if all case branches were embedded in a single list. - -101. 11/7/91 Switched to use "pid_t" and "uid_t" and other official -POSIC types and function prototypes. - ------------------ Released version 6.1, 11/7/91 ------------------ - -102. 12/2/91 Modified Tcl_ScanElement and Tcl_ConvertElement in several -ways. First, allowed caller to request that only backslashes be used -(no braces). Second, made Tcl_ConvertElement more aggressive in using -backslashes for braces and quotes. - -103. 12/5/91 Added "type", "lstat", and "readlink" options to "file" -command, plus added new "type" element to output of "stat" and "lstat" -options. - -104. 12/10/91 Manual entries had first lines that caused "man" program -to try weird preprocessor. Added blank comment lines to fix problem. - -105. 12/16/91 Fixed a few bugs in auto_mkindex proc: wasn't handling -errors properly, and hadn't been upgraded for new "regexp" syntax. - -106. 1/2/92 Fixed bug in "file" command where it didn't properly handle -a file names containing tildes where the indicated user doesn't exist. - -107. 1/2/92 Fixed lots of cases in tclUnixStr.c where two different -errno symbols (e.g. EWOULDBLOCK and EAGAIN) have the same number; Tcl -will only use one of them. - -108. 1/2/92 Lots of changes to configuration script to handle many more -systems more gracefully. E.g. should now detect the bogus strtoul that -comes with AIX and substitute Tcl's own version instead. - ------------------ Released version 6.2, 1/10/92 ------------------ - -109. 1/20/92 Config didn't have code to actually use "uid_t" variable -to set TCL_UIT_T #define. - -110. 2/10/92 Tcl_Eval didn't properly reset "numLevels" variable when -too-deep recursion occurred. - -111. 2/29/92 Added "on" and "off" to keywords accepted by Tcl_GetBoolean. - -112. 3/19/92 Config wasn't installing default version of strtod.c for -systems that don't have one in libc.a. - -113. 3/23/92 Fixed bug in tclExpr.c where numbers with leading "."s, -like 0.75, couldn't be properly substituted into expressions with -variable or command substitution. - -114. 3/25/92 Fixed bug in tclUnixAZ.c where "gets" command wasn't -checking to make sure that it was able to write the variable OK. - -115. 4/16/92 Fixed bug in tclUnixAZ.c where "read" command didn't -compute file size right for device files. - -116. 4/23/92 Fixed but in tclCmdMZ.c where "trace vinfo" was overwriting -the trace command. - ------------------ Released version 6.3, 5/1/92 ------------------ - -117. 5/1/92 Added Tcl_GlobalEval. - -118. 6/1/92 Changed auto-load facility to source files at global level. - -119. 6/8/92 Tcl_ParseVar wasn't always setting termPtr after errors, which -sometimes caused core dumps. - -120. 6/21/92 Fixed bug in initialization of regexp pattern cache. This -bug caused segmentation violations in regexp commands under some conditions. - -121. 6/22/92 Changed implementation of "glob" command to eliminate -trailing slashes on directory names: they confuse some systems. There -shouldn't be any user-visible changes in functionality except for names -in error messages not having trailing slashes. - -122. 7/2/92 Fixed bug that caused 'string match ** ""' to return 0. - -123. 7/2/92 Fixed bug in Tcl_CreateCmdBuf where it wasn't initializing -the buffer to an empty string. - -124. 7/6/92 Fixed bug in "case" command where it used NULL pattern string -after errors in the "default" clause. - -125. 7/25/92 Speeded up auto_load procedure: don't reread all the index -files unless the path has changed. - -126. 8/3/92 Changed tclUnix.h to define MAXPATHLEN from PATH_MAX, not -_POSIX_PATH_MAX. - ------------------ Released version 6.4, 8/7/92 ------------------ - -127. 8/10/92 Changed tclBasic.c so that comment lines can be continued by -putting a backslash before the newline. - -128. 8/21/92 Modified "unknown" to allow the source-ing of a file for -an auto-load to trigger other nested auto-loads, as long as there isn't -any recursion on the same command name. - -129. 8/25/92 Modified "format" command to allow " " and "+" flags, and -allow flags in any order. - -130. 9/14/92 Modified Tcl_ParseVar so that it doesn't actually attempt -to look up the variable if "noEval" mode is in effect in the interpreter -(it just parses the name). This avoids the errors that used to occur -in statements like "expr {[info exists foo] && $foo}". - -131. 9/14/92 Fixed bug in "uplevel" command where it didn't output the -correct error message if a level was specified but no command. - -132. 9/14/92 Renamed manual entries to have extensions like .3 and .n, -and added "install" target to Makefile. - -133. 9/18/92 Modified "unknown" command to emulate !!, !, and -^^ csh history substitutions. - -134. 9/21/92 Made the config script cleverer about figuring out which -switches to pass to "nm". - -135. 9/23/92 Fixed tclVar.c to be sure to copy flags when growing variables. -Used to forget about traces in progress and make extra recursive calls -on trace procs. - -136. 9/28/92 Fixed bug in auto_reset where it was unsetting variables -that might not exist. - -137. 10/7/92 Changed "parray" library procedure to print any array -accessible to caller, local or global. - -138. 10/15/92 Fixed bug where propagation of new environment variable -values among interpreters took N! time if there exist N interpreters. - -139. 10/16/92 Changed auto_reset procedure so that it also deletes any -existing procedures that are in the auto_load index (the assumption is -that they should be re-loaded to get the latest versions). - -140. 10/21/92 Fixed bug that caused lists to be incorrectly generated -for elements that contained backslash-newline sequences. - -141. 12/9/92 Added support for TCL_LIBRARY environment variable: use -it as library location if it's present. - -142. 12/9/92 Added "info complete" command, Tcl_CommandComplete procedure. - -143. 12/16/92 Changed the Makefile to check to make sure "config" has been -run (can't run config directly from the Makefile because it modifies the -Makefile; thus make has to be run again after running config). - ------------------ Released version 6.5, 12/17/92 ------------------ - -144. 12/21/92 Changed config to look in several places for libc file. - -145. 12/23/92 Added "elseif" support to if. Also, "then", "else", and -"elseif" may no longer be abbreviated. -*** POTENTIAL INCOMPATIBILITY *** - -146. 12/28/92 Changed "puts" and "read" to support initial "-nonewline" -switch instead of additional "nonewline" argument. The old form is -still supported, but it is discouraged and is no longer documented. -Also changed "puts" to make the file argument default to stdout: e.g. -"puts foo" will print foo on standard output. - -147. 1/6/93 Fixed bug whereby backslash-newline wasn't working when -typed interactively, or in "info complete". - -148. 1/22/93 Fixed bugs in "lreplace" and "linsert" where close -quotes were being lost from last element before replacement or -insertion. - -149. 1/29/93 Fixed bug in Tcl_AssembleCmd where it wasn't requiring -a newline at the end of a line before considering a command to be -complete. The bug caused some very long lines in script files to -be processed as multiple separate commands. - -150. 1/29/93 Various changes in Makefile to add more configuration -options, simplify installation, fix bugs (e.g. don't use -f switch -for cp), etc. - -151. 1/29/93 Changed "name1" and "name2" identifiers to "part1" and -"part2" to avoid name conflicts with stupid C++ implementations that -use "name1" and "name2" in a reserved way. - -152. 2/1/93 Added "putenv" procedure to replace the standard system -version so that it will work correctly with Tcl's environment handling. - ------------------ Released version 6.6, 2/5/93 ------------------ - -153. 2/10/93 Fixed bugs in config script: missing "endif" in libc loop, -and tried to use strncasecmp.c instead of strcasecmp.c. - -154. 2/10/93 Makefile improvements: added RANLIB variable for easier -Sys-V configuration, added SHELL variable for SGI systems. - ------------------ Released version 6.7, 2/11/93 ------------------ - -153. 2/6/93 Changes in backslash processing: - - \Cx, \Mx, \CMx, \e sequences no longer special - - \ also eats up any space after the newline, replacing - the whole sequence with a single space character - - Hex sequences like \x24 are now supported, along with ANSI C's \a. - - "format" no longer does backslash processing on its format string - - there is no longer any special meaning to a 0 return value from - Tcl_Backslash - - unknown backslash sequences, like (e.g. \*), are replaced with - the following character (e.g. *), instead of just treating the - backslash as an ordinary character. -*** POTENTIAL INCOMPATIBILITY *** - -154. 2/6/93 Updated all copyright notices. The meaning hasn't changed -at all but the wording does a better job of protecting U.C. from -liability (according to U.C. lawyers, anyway). - -155. 2/6/93 Changed "regsub" so that it overwrites the result variable -in all cases, even if there is no match. -*** POTENTIAL INCOMPATIBILITY *** - -156. 2/8/93 Added support for XPG3 %n$ conversion specifiers to "format" -command. - -157. 2/17/93 Fixed bug in Tcl_Eval where errors due to infinite -recursion could result in core dumps. - -158. 2/17/93 Improved the auto-load mechanism to deal gracefully (i.e. -return an error) with a situation where a library file that supposedly -defines a procedure doesn't actually define it. - -159. 2/17/93 Renamed Tcl_UnixError procedure to Tcl_PosixError, and -changed errorCode variable usage to use POSIX as keyword instead of -UNIX. -*** POTENTIAL INCOMPATIBILITY *** - -160. 2/19/93 Changes to exec and process control: - - Added support for >>, >&, >>&, |&, <@, >@, and >&@ forms of redirection. - - When exec puts processes into background, it returns a list of - their pids as result. - - Added support for file, etc. (i.e. no space between - ">" and file name. - - Added -keepnewline option. - - Deleted Tcl_Fork and Tcl_WaitPids procedures (just use fork and - waitpid instead). - - Added waitpid compatibility procedure for systems that don't have - it. - - Added Tcl_ReapDetachedProcs procedure. - - Changed "exec" to return an error if there is stderr output, even - if the command returns a 0 exit status (it's always been documented - this way, but the implementation wasn't correct). - - If a process returns a non-zero exit status but doesn't generate - any diagnostic output, then Tcl generates an error message for it. -*** POTENTIAL INCOMPATIBILITY *** - -161. 2/25/93 Fixed two memory-management problems having to do with -managing the old result during variable trace callbacks. - -162. 3/1/93 Added dynamic string library: Tcl_DStringInit, Tcl_DStringAppend, -Tcl_DStringFree, Tcl_DStringResult, etc. - -163. 3/1/93 Modified glob command to only return the names of files that -exist, and to only return names ending in "/" if the file is a directory. -*** POTENTIAL INCOMPATIBILITY *** - -164. 3/19/93 Modified not to use system calls like "read" directly, -but instead to use special Tcl procedures that retry automatically -if interrupted by signals. - -165. 4/3/93 Eliminated "noSep" argument to Tcl_AppendElement, plus -TCL_NO_SPACE flag for Tcl_SetVar and Tcl_SetVar2. -*** POTENTIAL INCOMPATIBILITY *** - -166. 4/3/93 Eliminated "flags" and "termPtr" arguments to Tcl_Eval. -*** POTENTIAL INCOMPATIBILITY *** - -167. 4/3/93 Changes to expressions: - - The "expr" command now accepts multiple arguments, which are - concatenated together with space separators. - - Integers aren't automatically promoted to floating-point if they - overflow the word size: errors are generated instead. - - Tcl can now handle "NaN" and other special values if the underlying - library procedures handle them. - - When printing floating-point numbers, Tcl ensures that there is a "." - or "e" in the number, so it can't be treated as an integer accidentally. - The procedure Tcl_PrintDouble is available to provide this function - in other contexts. Also, the variable "tcl_precision" can be used - to set the precision for printing (must be a decimal number giving - digits of precision). - - Expressions now support transcendental and other functions, e.g. sin, - acos, hypot, ceil, and round. Can add new math functions with - Tcl_CreateMathFunc(). - - Boolean expressions can now have any of the string values accepted - by Tcl_GetBoolean, such as "yes" or "no". -*** POTENTIAL INCOMPATIBILITY *** - -168. 4/5/93 Changed Tcl_UnsetVar and Tcl_UnsetVar2 to return TCL_OK -or TCL_ERROR instead of 0 or -1. -*** POTENTIAL INCOMPATIBILITY *** - -169. 4/5/93 Eliminated Tcl_CmdBuf structure and associated procedures; -can use Tcl_DStrings instead. -*** POTENTIAL INCOMPATIBILITY *** - -170. 4/8/93 Changed interface to Tcl_TildeSubst to use a dynamic -string for buffer space. This makes the procedure re-entrant and -thread-safe, whereas it wasn't before. -*** POTENTIAL INCOMPATIBILITY *** - -171. 4/14/93 Eliminated tclHash.h, and moved everything from it to -tcl.h -*** POTENTIAL INCOMPATIBILITY *** - -172. 4/15/93 Eliminated Tcl_InitHistory, made "history" command always -be part of interpreter. -*** POTENTIAL INCOMPATIBILITY *** - -173. 4/16/93 Modified "file" command so that "readable" option always -exists, even on machines that don't support symbolic links (always returns -same error as if the file wasn't a symbolic link). - -174. 4/26/93 Fixed bugs in "regsub" where ^ patterns didn't get handled -right (pretended not to match when it really did, and looped infinitely -if -all was specified). - -175. 4/29/93 Various improvements in the handling of variables: - - Can create variables and array elements during a read trace. - - Can delete variables during traces (note: unset traces will be - invoked when this happens). - - Can upvar to array elements. - - Can retarget an upvar to another variable by re-issuing the - upvar command with a different "other" variable. - -176. 5/3/93 Added Tcl_GetCommandInfo, which returns info about a Tcl -command such as whether it exists and its ClientData. Also added -Tcl_SetCommandInfo, which allows any of this information to be modified -and also allows a command's delete procedure to have a different -ClientData value than its command procedure. - -177. 5/5/93 Added Tcl_RegExpMatch procedure. - -178. 5/6/93 Fixed bug in "scan" where it didn't properly handle -%% conversion specifiers. Also changed "scan" to use Tcl_PrintDouble -for printing real values. - -179. 5/7/93 Added "-exact", "-glob", and "-regexp" options to "lsearch" -command to allow different kinds of pattern matching. - -180. 5/7/93 Added many new switches to "lsort" to control the sorting -process: "-ascii", "-integer", "-real", "-command", "-increasing", -and "-decreasing". - -181. 5/10/93 Changes to file I/O: - - Modified "open" command to support a list of POSIX access flags - like {WRONLY CREAT TRUNC} in addition to current fopen-style - access modes. Also added "permissions" argument to set permissions - of newly-created files. - - Fixed Scott Bolte's bug (can close stdin etc. in application and - then re-open them with Tcl commands). - - Exported access to Tcl's file table with new procedures Tcl_EnterFile - and Tcl_GetOpenFile. - -182. 5/15/93 Added new "pid" command, which can be used to retrieve -either the current process id or a list of the process ids in a -pipeline opened with "open |..." - -183. 6/3/93 Changed to use GNU autoconfig for configuration instead of -the home-brew "config" script. Also made many other configuration-related -changes, such as using instead of explicitly declaring system -calls in tclUnix.h. - -184. 6/4/93 Fixed bug where core-dumps could occur if a procedure -redefined itself (the memory for the procedure's body could get -reallocated in the middle of evaluating the body); implemented -simple reference count mechanism. - -185. 6/5/93 Changed tclIndex file format in two ways: (a) it's now -eval-ed instead of parsed, which makes it 3-4x faster; (b) the entries -in auto_index are now commands to evaluate, which allows commands to -be loaded in different ways such as dynamic-loading of C code. The -old tclIndex file format is still supported. - -186. 6/7/93 Eliminated tclTest program, added new "tclsh" program -that is more like wish (allows script files to be invoked automatically -using "#!/usr/local/bin/tclsh", makes arguments available to script, -etc.). Added support for Tcl_AppInit plus default version; this -allows new Tcl applications to be created without modifying the -main program for tclsh. - -187. 6/7/93 Fixed bug in TclWordEnd that kept backslash-newline from -working correctly in some cases during interactive input. - -188. 6/9/93 Added Tcl_LinkVar and related procedures, which automatically -keep a Tcl variable in sync with a C variable. - -189. 6/16/93 Increased maximum nesting depth from 100 to 1000. - -190. 6/16/93 Modified "trace var" command so that error messages from -within traces are returned properly as the result of the variable -access, instead of the generic "access disallowed by trace command" -message. - -191. 6/16/93 Added Tcl_CallWhenDeleted to provide callbacks when an -interpreter is deleted (same functionality as Tcl_WatchInterp, which -used to exist in versions before 6.0). - -193. 6/16/93 Added "-code" argument to "return" command; it's there -primarily for completeness, so that procedures implementing control -constructs can reflect exceptional conditions back to their callers. - -194. 6/16/93 Split up Tcl.n to make separate manual entries for each -Tcl command. Tcl.n now contains a summary of the language syntax. - -195. 6/17/93 Added new "switch" command to replace "case": allows -alternate forms of pattern matching (exact, glob, regexp), replaces -pattern lists with single patterns (but you can use "-" bodies to -share one body among several patterns), eliminates "in" noise word. -"Case" command is now obsolete. - -196. 6/17/93 Changed the "exec", "glob", "regexp", and "regsub" commands -to include a "--" switch. All initial arguments starting with "-" are now -treated as switches unless a "--" switch is present to end the list. -*** POTENTIAL INCOMPATIBILITY *** - -197. 6/17/93 Changed auto-exec so that the subprocess gets stdin, stdout, -and stderr from the parent. This allows truly interactive sub-processes -(e.g. vi) to be auto-exec'ed from a tcl shell command line. - -198. 6/18/93 Added patchlevel.h, for use in coordinating future patch -releases, and also added "info patchlevel" command to make the patch -level available to Tcl scripts. - -199. 6/19/93 Modified "glob" command so that a leading "//" in a name -gets left as is (this is needed for systems like Apollos where "//" is -the super-root; Tcl used to collapse the two slashes into a single -slash). - -200. 7/7/93 Added Tcl_SetRecursionLimit procedure so that the maximum -allowable nesting depth can be controlled for an interpreter from C. - ------------------ Released version 7.0 Beta 1, 7/9/93 ------------------ - -201. 7/12/93 Modified Tcl_GetInt and tclExpr.c so that full-precision -unsigned integers can be specified without overflow errors. - -202. 7/12/93 Configuration changes: eliminate leading blank line in -configure script; provide separate targets in Makefile for installing -binary and non-binary information; check for size_t and a few other -potentially missing typedefs; don't put tclAppInit.o into libtcl.a; -better checks for matherr support. - -203. 7/14/93 Changed tclExpr.c to check the termination pointer before -errno after strtod calls, to avoid problems with some versions of -strtod that set errno in unexpected ways. - -204. 7/16/93 Changed "scan" command to be more ANSI-conformant: -eliminated %F, %D, etc., added code to ignore "l", "h", and "L" -modifiers but always convert %e, %f, and %g with implicit "l"; -also added support for %u and %i. Also changed "format" command -to eliminate %D, %U, %O, and add %i. -*** POTENTIAL INCOMPATIBILITY *** - -205. 7/17/93 Changed "uplevel" and "upvar" so that they can be used -from global level to global level: this used to generate an error. - -206. 7/19/93 Renamed "setenv", "putenv", and "unsetenv" procedures -to avoid conflicts with system procedures with the same names. If -you want Tcl's procedures to override the system procedures, do it -in the Makefile (instructions are in the Makefile). -*** POTENTIAL INCOMPATIBILITY *** - ------------------ Released version 7.0 Beta 2, 7/21/93 ------------------ - -207. 7/21/93 Fixed bug in tclVar.c where freed memory was accidentally -used if a procedure returned an element of a local array. - -208. 7/22/93 Fixed bug in "unknown" where it didn't properly handle -errors occurring in the "auto_load" procedure, leaving its state -inconsistent. - -209. 7/23/93 Changed exec's ">2" redirection operator to "2>" for -consistency with sh. This is incompatible with earlier beta releases -of 7.0 but not with pre-7.0 releases, which didn't support either -operator. - -210. 7/28/93 Changed backslash-newline handling so that the resulting -space character *is* treated as a word separator unless the backslash -sequence is in quotes or braces. This is incompatible with 7.0b1 -and 7.0b2 but is more compatible with pre-7.0 versions that the b1 -and b2 releases were. - -211. 7/28/93 Eliminated Tcl_LinkedVarWritable, added TCL_LINK_READ_ONLY to -Tcl_LinkVar to accomplish same purpose. This change is incompatible -with earlier beta releases, but not with releases before Tcl 7.0. - -212. 7/29/93 Renamed regexp C functions so they won't clash with POSIX -regexp functions that use the same name. - -213. 8/3/93 Added "-errorinfo" and "-errorcode" options to "return" -command: these allow for much better handling of the errorInfo -and errorCode variables in some cases. - -214. 8/12/93 Changed "expr" so that % always returns a remainder with -the same sign as the divisor and absolute value smaller than the -divisor. - -215. 8/14/93 Turned off auto-exec in "unknown" unless the command -was typed interactively. This means you must use "exec" when -invoking subprocesses, unless it's a command that's typed interactively. -*** POTENTIAL INCOMPATIBILITY *** - -216. 8/14/93 Added support for tcl_prompt1 and tcl_prompt2 variables -to tclMain.c: makes prompts user-settable. - -217. 8/14/93 Added asynchronous handlers (Tcl_AsyncCreate etc.) so -that signals can be taken cleanly by Tcl applications. - -218. 8/16/93 Moved information about open files from the interpreter -structure to global variables so that a file can be opened in one -interpreter and read or written in another. - -219. 8/16/93 Removed ENV_FLAGS from Makefile, so that there's no -official support for overriding setenv, unsetenv, and putenv. - -220. 8/20/93 Various configuration improvements: coerce chars -to unsigned chars before using macros like isspace; source ~/.tclshrc -file during initialization if it exists and program is running -interactively; allow there to be directories in auto_path that don't -exist or don't have tclIndex files (ignore them); added Tcl_Init -procedure and changed Tcl_AppInit to call it. - -221. 8/21/93 Fixed bug in expr where "+", "-", and " " were all -getting treated as integers with value 0. - -222. 8/26/93 Added "tcl_interactive" variable to tclsh. - -223. 8/27/93 Added procedure Tcl_FilePermissions to return whether a -given file can be read or written or both. Modified Tcl_EnterFile -to take a permissions mask rather than separate read and write arguments. - -224. 8/28/93 Fixed performance bug in "glob" command (unnecessary call -to "access" for each file caused a 5-10x slow-down for big directories). - ------------------ Released version 7.0 Beta 3, 8/28/93 ------------------ - -225. 9/9/93 Renamed regexp.h to tclRegexp.h to avoid conflicts with system -include file by same name. - -226. 9/9/93 Added Tcl_DontCallWhenDeleted. - -227. 9/16/93 Changed not to call exit C procedure directly; instead -always invoke "exit" Tcl command so that application can redefine the -command to do additional cleanup. - -228. 9/17/93 Changed auto-exec to handle names that contain slashes -(i.e. don't use PATH for them). - -229. 9/23/93 Fixed bug in "read" and "gets" commands where they didn't -clear EOF conditions. - ------------------ Released version 7.0, 9/29/93 ------------------ - -230. 10/7/93 "Scan" command wasn't properly aligning things in memory, -so segmentation faults could arise under some circumstances. - -231. 10/7/93 Fixed bug in Tcl_ConvertElement where it forgot to -backslash leading curly brace when creating lists. - -232. 10/7/93 Eliminated dependency of tclMain.c on tclInt.h and -tclUnix.h, so that people can copy the file out of the Tcl source -directory to make modified private versions. - -233. 10/8/93 Fixed bug in auto-loader that reversed the priority order -of entries in auto_path for new-style index files. Now things are -back to the way they were before 3.0: first in auto_path is always -highest priority. - -234. 10/13/93 Fixed bug where Tcl_CommandComplete didn't recognize -comments and treat them as such. Thus if you typed the line - # { -interactively, Tcl would think that the command wasn't complete and -wait for more input before evaluating the script. - -235. 10/14/93 Fixed bug where "regsub" didn't set the output variable -if the input string was empty. - -236. 10/23/93 Fixed bug where Tcl_CreatePipeline didn't close off enough -file descriptors in child processes, causing children not to exit -properly in some cases. - -237. 10/28/93 Changed "list" and "concat" commands not to generate -errors if given zero arguments, but instead to just return an empty -string. - ------------------ Released version 7.1, 11/4/93 ------------------ - -Note: there is no 7.2 release. It was flawed and was thus withdrawn -shortly after it was released. - -238. 11/10/93 TclMain.c didn't compile on some systems because of -R_OK in call to "access". Changed to eliminate call to "access". - ------------------ Released version 7.3, 11/26/93 ------------------ - -239. 11/6/93 Modified "lindex", "linsert", "lrange", and "lreplace" -so that "end" can be specified as an index. - -240. 11/6/93 Modified "append" and "lappend" to allow only two -words total (i.e., nothing to append) without generating an error. - -241. 12/2/93 Changed to use EAGAIN as the errno for non-blocking -I/O instead of EWOULDBLOCK: this should fix problem where non-blocking -I/O didn't work correctly on System-V systems. - -242. 12/22/93 Fixed bug in expressions where cancelled evaluation -wasn't always working correctly (e.g. "set one 1; eval {1 || 1/$one}" -failed with a divide by zero error). - -243. 1/6/94 Changed TCL_VOLATILE definition from -1 to the address of -a dummy procedure Tcl_Volatile, since -1 causes portability problems on -some machines (e.g., Crays). - -244. 2/4/94 Added support for unary plus. - -245. 2/17/94 Changed Tcl_RecordAndEval and "history" command to -call Tcl_GlobalEval instead of Tcl_Eval. Otherwise, invocation of -these facilities in nested procedures can cause unwanted results. - -246. 2/17/94 Fixed bug in tclExpr.c where an expression such as -"expr {"12398712938788234-1298379" != ""}" triggers an integer -overflow error for the number in quotes, even though it isn't really -a proper integer anyway. - -247. 2/19/94 Added new procedure Tcl_DStringGetResult to move result -from interpreter to a dynamic string. - -248. 2/19/94 Fixed bug in Tcl_DStringResult that caused it to overwrite -the contents of a static result in some situations. This can cause -bizarre errors such as variables suddenly having empty values. - -249. 2/21/94 Fixed bug in Tcl_AppendElement, Tcl_DStringAppendElement, -and the "lappend" command that caused improper omission of a separator -space in some cases. For example, the script - set x "abc{"; lappend x "def" -used to return the result "abc{def" instead of "abc{ def". - -250. 3/3/94 Tcl_ConvertElement was outputting empty elements as \0 if -TCL_DONT_USE_BRACES was set. This depends on old pre-7.0 meaning of -\0, which is no longer in effect, so it didn't really work. Changed -to output empty elements as {} always. - -251. 3/3/94 Renamed Tcl_DStringTrunc to Tcl_DStringSetLength and extended -it so that it can be used to lengthen a string as well as shorten it. -Tcl_DStringTrunc is defined as a macro for backward compatibility, but -it is deprecated. - -252. 3/3/94 Added Tcl_AllowExceptions procedure. - -253. 3/13/94 Fixed bug in Tcl_FormatCmd that could cause "format" -to mis-behave on 64-bit Big-Endian machines. - -254. 3/13/94 Changed to use vfork instead of fork on systems where -vfork exists. - -255. 3/23/94 Fixed bug in expressions where ?: didn't associate -right-to-left as they should. - -256. 4/3/94 Fixed "exec" to flush any files used in >@ or >&@ -redirection in exec, so that data buffered for them is written -before any new data added by the subprocess. - -257. 4/3/94 Added "subst" command. - -258. 5/20/94 The tclsh main program is now called Tcl_Main; tclAppInit.c -has a "main" procedure that calls Tcl_Main. This makes it easier to use -Tcl with C++ programs, which need their own main programs, and it also -allows an application to prefilter the argument list before calling -Tcl_Main. -*** POTENTIAL INCOMPATIBILITY *** - -259. 6/6/94 Fixed bug in procedure returns where the errorInfo variable -could get truncated if an unset trace was invoked as part of returning -from the procedure. - -260. 6/13/94 Added "wordstart" and "wordend" options to "string" command. - -261. 6/27/94 Fixed bug in expressions where they didn't properly cancel -the evaluation of math functions in &&, ||, and ?:. - -262. 7/11/94 Incorrect boolean values, like "ogle", weren't being -handled properly. - -263. 7/15/94 Added Tcl_RegExpCompile, Tcl_RegExpExec, and Tcl_RegExpRange, -which provide lower-level access to regular expression pattern matching. - -264. 7/22/94 Fixed bug in "glob" command where "glob -nocomplain ~bad_user" -would complain about a missing user. Now it doesn't complain anymore. - -265. 8/4/94 Fixed bug with linked variables where they didn't behave -correctly when accessed via upvars. - -266. 8/17/94 Fixed bug in Tcl_EvalFile where it didn't clear interp->result. - -267. 8/31/94 Modified "open" command so that errors in exec-ing -subprocesses are returned by the open immediately, rather than -being delayed until the "close" is executed. - -268. 9/9/94 Modified "expr" command to generate errors for integer -overflow (includes addition, subtraction, negation, multiplication, -division). - -269. 9/23/94 Modified "regsub" to return a count of the number of -matches and replacements, rather than 0/1. - -279. 10/4/94 Added new features to "array" command: - - added "get" and "set" commands for easy conversion between arrays - and lists. - - added "exists" command to see if a variable is an array, changed - "names" and "size" commands to treat a non-existent array (or scalar - variable) just like an empty one. - - added pattern option to "names" command. - -280. 10/6/94 Modified Tcl_SetVar2 so that read traces on variables get -called during append operations. - -281. 10/20/94 Fixed bug in "read" command where reading from stdin -required two control-D's to stop the reading. - -282. 11/3/94 Changed "expr" command to use longs for division just like -all other expr operators; it previously used ints for division. - -283. 11/4/94 Fixed bugs in "unknown" procedure: it wasn't properly -handling exception returns from commands that were executed after -being auto-loaded. - ------------------ Released version 7.4b1, 12/23/94 ------------------ - -284. 12/26/94 Fixed "install" target in Makefile (couldn't always -find install program). - -285. 12/26/94 Added strcncasecmp procedure to compat directory. - -286. 1/3/95 Fixed all procedure calls to explicitly cast arguments: -implicit conversions from prototypes (especially integer->double) -don't work when compiling under non-ANSI compilers. Tcl is now clean -under gcc -Wconversion. - -287. 1/4/95 Fixed problem in Tcl_ArrayCmd where same name was used for -both a label and a variable; caused problems on several older compilers, -making array command misbehave and causing many errors in Tcl test suite. - ------------------ Released version 7.4b2, 1/12/95 ------------------ - -288. 2/9/95 Modified Tcl_CreateCommand to return a token, and added -Tcl_GetCommandName procedure. Together, these procedures make it possible -to track renames of a command. - -289. 2/13/95 Fixed bug in expr where "089" was interpreted as a -floating-point number rather than a bogus octal number. -*** POTENTIAL INCOMPATIBILITY *** - -290. 2/14/95 Added code to Tcl_GetInt and Tcl_GetDouble to check for -overflows when reading in numbers. - -291. 2/18/95 Changed "array set" to stop after first error, rather than -continuing after error. - -292. 2/20/95 Upgraded to use autoconf version 2.2. - -293. 2/20/95 Fixed core dump that could occur in "scan" command if a -close bracket was omitted. - -294. 2/27/95 Changed Makefile to always use install-sh for installations: -there's just too much variation among "install" system programs, which -makes installation flakey. - ------------------ Released version 7.4b3, 3/24/95 ------------------ - -3/25/95 (bug fix) Changed "install" to "./install" in Makefile so that -"make install" will work even when "." isn't in the search path. - -3/29/95 (bug fix) Fixed bug where the auto-loading mechanism wasn't -protecting the values of the errorCode and errorInfo variables. - -3/29/95 (new feature) Added optional pattern argument to "parray" procedure. - -3/29/95 (bug fix) Made the full functionality of - "return -code ... -errorcode ..." -work not just inside procedures, but also in sourced files and at -top level. - -4/6/95 (new feature) Added "pattern" option to "array names" command. - -4/18/95 (bug fix) Fixed bug in parser where it didn't allow backslash-newline -immediately after an argument in braces or quotes. - -4/19/95 (new feature) Added tcl_library variable, which application can -set to override default library directory. - -4/30/95 (bug fix) During trace callbacks for array elements, the variable -name used in the original reference would be temporarily modified to -separate the array name and element name; if the trace callback used -the same name string, it would get the wrong name (the array name without -element). Fixed to restore the variable name before making trace -callbacks. - -4/30/95 (new feature) Added -nobackslashes, -nocommands, and -novariables -switches to "subst" command. - -5/4/95 (new feature) Added TCL_EVAL_GLOBAL flag to Tcl_RecordAndEval. - -5/5/95 (bug fix) Format command would overrun memory when printing -integers with very large precision, as in "format %.1000d 0". - -5/5/95 (portability improvement) Changed to use BSDgettimeofday on -IRIX machines, to avoid compilation problems with the gettimeofday -declaration. - -5/6/95 (bug fix) Changed manual entries to use the standard .TH -macro instead of a custom .HS macro; the .HS macro confuses index -generators like makewhatis. - -5/9/95 (bug fix) Modified configure script to check for Solaris bug -that makes vfork unreliable (core dumps result if vforked child -changes a signal handler); will use fork instead of vfork if the -bug is present. - -6/5/95 (bug fix) Modified "lsort" command to disallow recursive calls -to lsort from a comparison function. This is needed because qsort -is not reentrant. - -6/5/95 (bug fix) Undid change 243 above: changed TCL_VOLATILE and -TCL_DYNAMIC back to integer constants rather than procedure addresses. -This was needed because procedure addresses can have multiple values -under some dynamic loading systems (e.g. SunOS 4.1 and Windows). - -6/8/95 (feature change) Modified interface to Tcl_Main to pass in the -address of the application-specific initialization procedure. -Tcl_AppInit is no longer hardwired into Tcl_Main. This is needed -in order to make Tcl a shared library. - -6/8/95 (feature change) Modified Makefile so that the installed versions -of tclsh and libtcl.a have version number in them (e.g. tclsh7.4 and -libtcl7.4.a) and the library directory name also has an embedded version -number (e.g., /usr/local/lib/tcl7.4). This should make it easier for -Tcl 7.4 to coexist with earlier versions. - ------------------ Released version 7.4b4, 6/16/95 ------------------ - -6/19/95 (bug fix) Fixed bugs in tclCkalloc.c that caused core dumps -if TCL_MEM_DEBUG was enabled on word-addressed machines such as Crays. - -6/21/95 (feature removal) Removed overflow checks for integer arithmetic: -they just cause too much trouble (e.g. for random number generators). - -6/28/95 (new features) Added tcl_patchLevel and tcl_version variables, -for consistency with Tk. - -6/29/95 (bug fix) Fixed problem in Tcl_Eval where it didn't record -the right termination character if a script ended with a comment. This -caused erroneous output for the following command, among others: -puts "[ -expr 1+1 -# duh! -]" - -6/29/95 (message change) Changed the error message for ECHILD slightly -to provide a hint about why the problem is occurring. - ------------------ Released version 7.4, 7/1/95 ------------------ - -7/18/95 (bug fix) Changed "lreplace" so that nothing is deleted if -the last index is less than the first index or if the last index -is < 0. - -7/18/95 (bug fix) Fixed bugs with backslashes in comments: -Tcl_CommandComplete (and "info complete") didn't properly handle -strings ending in backslash-newline, and neither Tcl_CommandComplete -nor the Tcl parser handled other backslash sequences right, such -as two backslashes before a newline. - -7/19/95 (bug fix) Modified Tcl_DeleteCommand to delete the hash table -entry for the command before invoking its callback. This is needed in -order to deal with reentrancy. - -7/22/95 (bug fix) "exec" wasn't reaping processes correctly after -certain errors (e.g. if the name of the executable was bogus, as -in "exec foobar"). - -7/27/95 (bug fix) Makefile.in wasn't using the LIBS variable provided -by the "configure" script. This caused problems on some SCO systems. - -7/27/95 (bug fix) The version of strtod in fixstrtod.c didn't properly -handle the case where endPtr == NULL. - ------------------ Released patch 7.4p1, 7/29/95 ----------------------- - -8/4/95 (bug fix) C-level trace callbacks for variables were sometimes -receiving the PART1_NOT_PARSED flag, which could cause errors in -subsequent Tcl library calls using the flags. (JO) - -8/4/95 (bug fix) Calls to toupper and tolower weren't using the -UCHAR macros, which caused trouble in non-U.S. locales. (JO) - -8/10/95 (new feature) Added the "load" command for dynamic loading of -binary packages, and the Tcl_PackageInitProc prototype for package -initialization procedures. (JO) - -8/23/95 (new features) Added "info sharedlibextension" and -"info nameofexecutable" commands, plus Tcl_FindExtension procedure. (JO) - -8/25/95 (bug fix) If the target of an "upvar" was non-existent but -had traces set, the traces were silently lost. Change to generate -an error instead. (JO) - -8/25/95 (bug fix) Undid change from 7/19, so that commands can stay -around while their deletion callbacks execute. Added lots of code to -handle all of the reentrancy problems that this opens up. (JO) - -8/25/95 (bug fix) Fixed core dump that could occur in TclDeleteVars -if there was an upvar from one entry in the table to the next entry -in the same table. (JO) - -8/28/95 (bug fix) Exec wasn't handling bad user names properly, as -in "exec ~bogus_user/foo". (JO) - -8/29/95 (bug fixes) Changed backslash-newline handling to correct two -problems: - - Only spaces and tabs following the backslash-newline are now - absorbed as part of the backslash-newline. Newlinew are no - longer absorbed (add another backslash if you want to absorb - another newline). - - TclWordEnd returns the character just before the backslash in - the sequence as the end of the sequence; it used to not consider - the backslash-newline as a word separator. (JO) - -8/31/95 (new feature) Changed man page installation (with "mkLinks" -script) to create additional links for manual pages corresponding to -each of the procedure and command names described in the pages. (JO) - -9/10/95 Reorganized Tcl sources for Windows and Mac ports. All sources -are now in subdirectories: "generic" contains sources that work on all -platforms, "windows", "mac", and "unix" directories contain platform- -specific sources. Some UNIX sources are also used on other platforms. (SS) - -9/10/95 (feature change) Eliminated exported global variables (they -don't work with Windows DLLs). Replaced tcl_AsyncReady and -tcl_FileCloseProc with procedures Tcl_AsyncReady() and -Tcl_SetFileCloseProc(). Replaced C variable tcl_RcFileName with -a Tcl variable tcl_rcFileName. (SS) -*** POTENTIAL INCOMPATIBILITY *** - -9/11/95 (new feature) Added procedure Tcl_SetPanicProc to override -the default implementation of "panic". (SS) - -9/11/95 (new feature) Added "interp" command to allow creation of -new interpreters and execution of untrusted scripts. Added many new -procedures, such as Tcl_CreateSlave, Tcl_CreateAlias,and Tcl_MakeSafe, -to provide C-level access to the interpreter facility. This mechanism -now provides almost all of the generic functions of Borenstein's and -Rose's Safe-Tcl (but not any Tk or email-related stuff). (JL) - -9/11/95 (feature change) Changed file management so that files are -no longer shared between interpreters: a file cannot normally be -referenced in one interpreter if it was opened in another. This -feature is needed to support safe interpreters. Added Tcl_ShareHandle() -procedure for allowing files to be shared, and added "interp" argument -to Tcl_FilePermissions procedure. (JL) -*** POTENTIAL INCOMPATIBILITY *** - -9/11/95 (new feature) Added "AssocData" mechanism, whereby extensions -can associate their own data with an interpreter and get called back -when the interpreter is deleted. This is visible at C level via the -procedures Tcl_SetAssocData and Tcl_GetAssocData. (JL) - -9/11/95 (new feature) Added Tcl_ErrnoMsg to translate an errno value -into a human-readable string. This is now used instead of calling -strerror because strerror mesages vary dramatically from platform -to platform, which messes up Tcl tests. Tcl_ErrnoMsg uses the standard -POSIX messages for all the common signals, and calls strerror for -signals it doesn't understand. - ------------------ Released patch 7.4p2, 9/15/95 ----------------------- - ------------------ Released 7.5a1, 9/15/95 ----------------------- - -9/22/95 (bug fix) Changed auto_mkindex to create tclIndex files that -handle directories whose paths might contain spaces. (RJ) - -9/27/95 (bug fix) The "format" command didn't check for huge or negative -width specifiers, which could cause core dumps. (JO) - -9/27/95 (bug fix) Core dumps could occur if an interactive command typed -to tclsh returned a very long result for tclsh to print out. The bug is -actually in printf (in Solaris 2.3 and 2.4, at least); switched to use -puts instead. (JO) - -9/28/95 (bug fix) Changed makefile.bc to eliminate a false dependency -for tcl1675.dll on the Borland run time library. (SS) - -9/28/95 (bug fix) Fixed tcl75.dll so it looks for tcl1675.dll instead -of tcl16.dll. (SS) - -9/28/95 (bug fix) Tcl was not correctly detecting the difference -between Win32s and Windows '95. (SS) - -9/28/95 (bug fix) "exec" was not passing environment changes to child -processes under Windows. (SS) - -9/28/95 (bug fix) Changed Tcl to ensure that open files are not passed -to child processes under Windows. (SS) - -9/28/95 (bug fix) Fixed Windows '95 and NT versions of exec so it can -handle both console and windows apps. (SS) - -9/28/95 (bug fix) Fixed Windows version of exec so it no longer leaves -temp files lying around. Also changed it so the temp files are -created in the appropriate system dependent temp directory. (SS) - -9/28/95 (bug fix) Eliminated source dependency on the Win32s Universal -Thunk header file, since it is not bundled with VC++. (SS) - -9/28/95 (bug fix) Under Windows, Tcl now constructs the HOME -environment variable from HOMEPATH and HOMEDRIVE when HOME is not -already set. (SS) - -9/28/95 (bug fix) Added support for "info nameofexecutable" and "info -sharedlibextension" to the Windows version. (SS) - -9/28/95 (bug fix) Changed tclsh to correctly parse command line -arguments so that backslashes are preserved under Windows. (SS) - -9/29/95 (bug fix) Tcl 7.5a1 treated either return or newline as end -of line in "gets", which caused lines ending in CRLF to be treated as -two separate lines. Changed to allow only character as end-of-line: -carriage return on Macs, newline elsewhere. (JO) - -9/29/95 (new feature) Changed to install "configInfo" file in same -directory as library scripts. It didn't used to get installed. (JO) - -9/29/95 (bug fix) Tcl was not converting Win32 errors into POSIX -errors under some circumstances. (SS) - -10/2/95 (bug fix) Safe interpreters no longer get initialized with -a call to Tcl_Init(). (JL) - -10/1/95 (new feature) Added "tcl_platform" global variable to provide -environment information such as the instruction set and operating -system. (JO) - -10/1/95 (bug fix) "exec" command wasn't always generating the -"child process exited abnormally" message when it should have. (JO) - -10/2/95 (bug fix) Changed "mkLinks.tcl" so that the scripts it generates -won't create links that overwrite original manual entries (there was -a problem where pack-old.n was overwriting pack.n). (JO) - -10/2/95 (feature change) Changed to use -ldl for dynamic loading under -Linux if it is available, but fall back to -ldld if it isn't. (JO) - -10/2/95 (bug fix) File sharing was causing refcounts to reach 0 -prematurely for stdin, stdout and stderr, under some circumstances. (JL) - -10/2/95 (platform support) Added support for Visual C++ compiler on -Windows, Windows '95 and Windows NT, code donated by Gordon Chaffee. (JL) - -10/3/95 (bug fix) Tcl now frees any libraries that it loads before it -exits. (SS) - -10/03/95 (bug fix) Fixed bug in Macintosh ls command where the -l -and -C options would fail in anything but the HOME directory. (RJ) - ------------------ Released 7.5a2, 10/6/95 ----------------------- - -10/10/95 (bug fix) "file dirnam /." was returning ":" on UNIX instead -of "/". (JO) - -10/13/95 (bug fix) Eliminated dependency on MKS toolkit for generating -the tcl.def file from Borland object files. (SS) - -10/17/95 (new features) Moved the event loop from Tcl to Tk, made major -revisions along the way: - - New Tcl commands: after, update, vwait (replaces "tkwait variable"). - - "tkerror" is now replaced with "bgerror". - - The following procedures are similar to their old Tk counterparts: - Tcl_DoOneEvent, Tcl_Sleep, Tcl_DoWhenIdle, Tcl_CancelIdleCall, - Tcl_CreateFileHandler, Tcl_DeleteFileHandler, Tcl_CreateTimerHandler, - Tcl_DeleteTimerHandler, Tcl_BackgroundError. - - Revised notifier, add new concept of "event source" with the following - procedures: Tcl_CreateEventSource, Tcl_DeleteEventSource, - Tcl_WatchFile, Tcl_SetMaxBlockTime, Tcl_FileReady, Tcl_QueueEvent, - Tcl_WaitForEvent. (JO) - -10/31/95 (new features) Implemented cross platform file name support to make -it easier to write cross platform scripts. Tcl now understands 4 file naming -conventions: Windows (both DOS and UNC), Mac, Unix, and Network. The network -convention is a new naming mechanism that can be used to paths in a platform -independent fashion. See the "file" command manual page for more details. -The primary interfaces changes are: - - All Tcl commands that expect a file name now accept both network and - native form. - - Two new "file" subcommands, "nativename" and "networkname", provide a - way to convert between network and native form. - - Renamed Tcl_TildeSubst to Tcl_TranslateFileName, and changed it so that - it always returns a filename in native form. Tcl_TildeSubst is defined - as a macro for backward compatibility, but it is deprecated. (SS) - -11/5/95 (new feature) Made "tkerror" and "bgerror" synonyms, so that -either name can be used to manipulate the command (provides temporary -backward compatibility for existing scripts that use tkerror). (JO) - -11/5/95 (new feature) Added exit handlers and new C procedures -Tcl_CreateExitHandler, Tcl_DeleteExitHandler, and Tcl_Exit. (JO) - -11/6/95 (new feature) Added pid command for Macintosh version of -Tcl (it didn't previously exist on the Mac). (RJ) - -11/7/95 (new feature) New generic IO facility and support for IO to -files, pipes and sockets based on a common buffering scheme. Support -for asynchronous (non-blocking) IO and for event driver IO. Support -for automatic (background) asynchronous flushing and asynchronous -closing of channels. (JL) - -11/7/95 (new feature) Added new commands "fconfigure" and "fblocked" -to support new I/O features such as nonblocking I/O. Added "socket" -command for creating TCP client and server sockets. (JL). - -11/7/95 (new feature) Complete set of C APIs to the new generic IO -facility: - - Opening channels: Tcl_OpenFileChannel, Tcl_OpenCommandChannel, - Tcl_OpenTcpClient, Tcl_OpenTcpServer. - - I/O procedures on channels, which roughly mirror the ANSI C stdio - library: Tcl_Read, Tcl_Gets, Tcl_Write, Tcl_Flush, Tcl_Seek, - Tcl_Tell, Tcl_Close, Tcl_Eof, Tcl_InputBlocked, Tcl_GetChannelOption, - Tcl_SetChannelOption. - - Extension mechanism for creating new kinds of channels: - Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, - Tcl_GetChannelName, Tcl_GetChannelFile, Tcl_RegisterChannel, - Tcl_UnregisterChannel, Tcl_GetChannel. - - Event-driven I/O on channels: Tcl_CreateChannelHandler, - Tcl_DeleteChannelHandler. (JL) - -11/7/95 (new feature) Channel driver interface specification to allow -new types of channels to be added easily to Tcl. Currently being used -in three drivers - for files, pipes and TCP-based sockets. (JL). - -11/7/95 (new feature) interp delete now takes any number of path -names of interpreters to delete, including zero. (JL). - -11/8/95 (new feature) implemented 'info hostname' and Tcl_GetHostName -command to get host name of machine on which the Tcl process is running. (JL) - -11/9/95 (new feature) Implemented file APIs for access to low level files -on each system. The APIs are: Tcl_CloseFile, Tcl_OpenFile, Tcl_ReadFile, -Tcl_WriteFile and Tcl_SeekFile. Also implemented Tcl_WaitPid which waits -in a system dependent manner for a child process. (JL) - -11/9/95 (new feature) Added Tcl_UpdateLinkedVar procedure to force a -Tcl variable to be updated after its C variable changes. (JO) - -11/9/95 (bug fix) The glob command has been totally reimplemented so -that it can support different file name conventions. It now handles -Windows file names (both UNC and drive-relative) properly. It also -supports nested braces correctly now. (SS) - -11/13/95 (bug fix) Fixed Makefile.in so that configure can be run -from a clean directory separate from the Tcl source tree, and compilations -can be performed there. (JO) - -11/14/95 (bug fix) Fixed file sharing between interpreters and file -transferring between interpreters to correctly manage the refcount so that -files are closed when the last reference to them is discarded. (JL) - -11/14/95 (bug fix) Fixed gettimeofday implementation for the -Macintosh. This fixes several timing related bugs. (RJ) - -11/17/95 (new feature) Added missing support for info nameofexecutable -on the Macintosh. (RJ) - -11/17/95 (bug fix) The Tcl variables argc argv and argv0 now return -something reasonable on the Mac. (RJ) - -11/22/95 (new feature) Implemented "auto-detect" mode for end of line -translations. On input, standalone "\r" mean MAC mode, standalone "\n" -mean Unix mode and "\r\n" means Windows mode. On output, the mode is -modified to whatever the platform specific mode for that platform is. (JL) - -11/24/95 (feature change) Replaced "configInfo" file with tclConfig.sh, -which is more complete and uses slightly different names. Also -arranged for tclConfig.sh to be installed in the platform-specific -library directory instead of Tcl's script library directory. (JO) -*** POTENTIAL INCOMPATIBILITY with Tcl 7.5a2, but not with Tcl 7.4 *** - ------------------ Released patch 7.4p3, 11/28/95 ----------------------- - -12/5/95 (new feature) Added Tcl_File facility to support platform- -independent file handles. Changed all interfaces that used Unix- -style integer fd's to use Tcl_File's instead. (SS) -*** POTENTIAL INCOMPATIBILITY *** - -12/5/95 (new feature) Added a new "clock" command to Tcl. The command -allows you to get the current "clicks" or seconds & allows you to -format or scan human readable time/date strings. (RJ) - -12/18/95 (new feature) Moved Tk_Preserve, Tk_Release, and Tk_EventuallyFree -to Tcl, renamed to Tcl_Preserve, Tcl_Release, and Tcl_EventuallyFree. (JO) - -12/18/95 (new feature) Added new "package" command and associated -procedures Tcl_PkgRequire and Tcl_PkgProvide. Also wrote -pkg_mkIndex library procedure to create index files from binaries -and scripts. (JO) - -12/20/95 (new feature) Added Tcl_WaitForFile procedure. (JO) - -12/21/95 (new features) Made package name argument to "load" optional -(Tcl will now attempt to guess the package name if necessary). Also -added Tcl_StaticPackage and support in "load" for statically linked -packages. (JO) - -12/22/95 (new feature) Upgraded the foreach command to accept multiple -loop variables and multiple value lists. This lets you iterate over -multiple lists in parallel, and/or assign multiple loop variables from -one value list during each iteration. The only potential compatibility -problem is with scripts that used loop variables with a name that could be -construed to be a list of variable names (i.e. contained spaces). (BW) - -1/5/96 (new feature) Changed tclsh so it builds as a console mode -application under Windows. Now tclsh can be used from the command -line with pipes or interactively. Note that this only works under -Windows 95 or NT. (SS) - -1/17/96 (new feature) Modified Makefile and configure script to allow -Tcl to be compiled as a shared library: use the --enable-shared option -when configuing. (JO) - -1/17/96 (removed obsolete features) Removed the procedures Tcl_EnterFile -and Tcl_GetOpenFile: these no longer make sense with the new I/O system. (JL) -*** POTENTIAL INCOMPATIBILITY *** - -1/19/96 (bug fixes) Prevented formation of circular aliases, through the -Tcl 'interp alias' command and through the 'rename' command, as well as -through the C API Tcl_CreateAlias. (JL) - -1/19/96 (bug fixes) Fixed several bugs in direct deletion of interpreters -with Tcl_DeleteInterp when the interpreter is a slave; fixes based on a -patch received from Viktor Dukhovni of ESM. (JL) - -1/19/96 (new feature) Implemented on-close handlers for channels; added -the C APIs Tcl_CreateCloseHandler and Tcl_DeleteCloseHandler. (JL) - -1/19/96 (new feature) Implemented portable error reporting mechanism; added -the C APIs Tcl_SetErrno and Tcl_GetErrno. (JL) - -1/24/96 (bug fix) Unknown command processing properly invokes external -commands under Windows NT and Windows '95 now. (SS) - -1/23/96 (bug fix) Eliminated extremely long startup times under Windows '95. -The problem was a result of the option database initialization code that -concatenated $HOME with /.Xdefaults, resulting in a // in the middle of the -file name. Under Windows '95, this is incorrectly interpreted as a UNC -path. They delays came from the network timeouts needed to determine that -the file name was invalid. Tcl_TranslateFileName now suppresses duplicate -slashes that aren't at the beginning of the file name. (SS) - -1/25/96 (bug fix) Changed exec and open to create children so they are -attached to the application's console if it exists. (SS) - -1/31/96 (bug fix) Fixed command line parsing to handle embedded -spaces under Windows. (SS) - ------------------ Released 7.5b1, 2/1/96 ----------------------- - -2/7/96 (bug fix) Fixed off by one error in argument parsing code under -Windows. (SS) - -2/7/96 (bug fix) Fixed bugs in VC++ makefile that improperly -initialized the tcl75.dll. Fixed bugs in Borland makefile that caused -build failures under Windows NT. (SS) - -2/9/96 (bug fix) Fixed deadlock problem in AUTO end of line translation -mode which would cause a socket server with several concurrent clients -writing in CRLF mode to hang. (JL) - -2/9/96 (API change) Replaced -linemode option to fconfigure with a -new -buffering option, added "none" setting to enable immediate write. (JL) -*** INCOMPATIBILITY with b1 *** - -2/9/96 (new feature) Added C API Tcl_InputBuffered which returns the count -of bytes currently buffered in the input buffer of a channel, and o for -output only channels. (JL) - -2/9/96 (new feature) Implemented asynchronous connect for sockets. (JL) - -2/9/96 (new feature) Added C API Tcl_SetDefaultTranslation to set (per -channel) the default end of line translation mode. This is the mode that -will be installed if an output operation is done on the channel while it is -still in AUTO mode. (JL) - -2/9/96 (bug fix) Changed Tcl_OpenCommandChannel interface to properly -handle all of the combinations of stdio inheritance in background -pipelines. See the Tcl_OpenFileChannel(3) man page for more -info. This change fixes the bug where exec of a background pipeline -was not getting passed the stdio handles properly. (SS) - -2/9/96 (bug fix) Removed the new Tcl_CreatePipeline interface, and -restored the old version for Unix platforms only. All new code should -use Tcl_CreateCommandChannel instead. (SS) - -2/9/96 (bug fix) Changed Makefile.in to use -L and -ltcl7.5 for Tcl -library so that shared libraries are more likely to be found correctly -on more platforms. (JO) - -2/13/96 (new feature) Added C API Tcl_SetNotifierData and -Tcl_GetNotifierData to allow notifier and channel driver writers to -associate data with a Tcl_File. The result of this change is that -Tcl_GetFileInfo now always returns an OS file handle, and Tcl_GetFile -can be used to construct a Tcl_File for an externally constructed OS -handle. (SS) - -2/13/96 (bug fix) Changed Windows socket implementation so it doesn't -set SO_REUSEADDR on server sockets. Now attempts to create a server -socket on a port that is already in use will be properly identified -and an error will be generated. (SS) - -2/13/96 (bug fix) Fixed problems with DLL initialization under Visual -C++ that left the C run time library uninitialized. (SS) - -2/13/96 (bug fix) Fixed Windows socket initialization so it loads -winsock the first time it is used, rather than at the time tcl75.dll -is loaded. This should fix the bug where the modem immediately starts -trying to connect to a service provider when wish or tclsh are -started. (SS) - -2/13/96 (new feature) Added C APIs Tcl_MakeFileChannel and -Tcl_MakeTcpClientChannel to wrap up existing fds and sockets into -channels. Provided implementations on Unix and Windows. (JL) - -2/13/96 (bug fix) Fixed bug with seek leaving EOF and BLOCKING set. (JL) - -2/14/96 (bug fix) Fixed reentrancy problem in fileevent handling -and made it more robust in the face of errors. (JL) - -2/14/96 (feature change) Made generic IO level emulate blocking mode if the -channel driver is unable to provide it, e.g. if the low level device is -always nonblocking. Thus, now blocking behavior is an advisory setting for -channel drivers and can be ignored safely if the channel driver is unable -to provide it. (JL) - -2/15/96 (new feature) Added "binary" end of line translation mode, which is -a synonym of "lf" mode. (JL) - -2/15/96 (bug fix) Fixed reentrancy problem in fileevent handling vs -deletion of channel event handlers. (JL) - -2/15/96 (bug fix) Fixed bug in event handling which would cause a -nonblocking channel to not see further readable events after the first -readable event that had insufficient input. (JL) - -2/17/96 (bug fix) "info complete" didn't properly handle comments -in nested commands. (JO) - -2/21/96 (bug fix) "exec" under Windows NT/95 did not properly handle -very long command lines (>200 chars). (SS) - -2/21/96 (bug fix) Sockets could get into an infinite loop if a read -event arrived after all of the available data had been read. (SS) - -2/22/96 (bug fix) Added cast of st_size elements to (long) before -sprintf-ing in "file size" command. This is needed to handle systems -like NetBSD with 64-bit file offsets. (JO) - ------------------ Released 7.5b2, 2/23/96 ----------------------- - -2/23/96 (bug fix) TCL_VARARGS macro in tcl.h wasn't defined properly -when compiling with C++. (JO) - -2/24/96 (bug fix) Removed dependencies on Makefile in the UNIX Makefile: -this caused problems on some platforms (like Linux?). (JO) - -2/24/96 (bug fix) Fixed configuration bug that made Tcl not compile -correctly on Linux machines with neither -ldl or -ldld. (JO) - -2/24/96 (new feature) Added a block of comments and definitions to -Makefile.in to make it easier to have Tcl's TclSetEnv etc. replace -the library procedures setenv etc, so that calls to setenv etc. in -the application automatically update the Tcl "env" variable. (JO) - -2/27/96 (feature change) Added optional Tcl_Interp * argument (may be NULL) -to C API Tcl_Close and simplified closing of command channels. (JL) -*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** - -2/27/96 (feature change) Added optional Tcl_Interp * argument (may be NULL) -to C type definition Tcl_DriverCloseProc; modified all channel drivers to -implement close procedures that accept the additional argument. (JL) -*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** - -2/28/96 (bug fix) Fixed memory leak that could occur if an upvar -referred to an element of an array in the same stack frame as the -upvar. (JO) - -2/29/96 (feature change) Modified both Tcl_DoOneEvent and Tcl_WaitForEvent -so that they return immediately in cases where they would otherwise -block forever (e.g. if there are no event handlers of any sort). (JO) - -2/29/96 (new feature) Added C APIs Tcl_GetChannelBufferSize and -Tcl_SetChannelBufferSize to set and retrieve the size, in bytes, for -buffers allocated to store input or output in a channel. (JL) - -2/29/96 (new feature) Added option -buffersize to Tcl fconfigure command -to allow Tcl scripts to query and set the size of channel buffers. (JL) - -2/29/96 (feature removed) Removed channel driver function to specify -the buffer size to use when allocating a buffer. Removed the C typedef -for Tcl_DriverBufferSizeProc. Channels are now created with a default -buffer size of 4K. (JL) -*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** - -2/29/96 (feature change) The channel driver function for setting blocking -mode on the device may now be NULL. If the generic code detects that the -function is NULL, operations that set the blocking mode on the channel -simply succeed. (JL) - -3/2/96 (bug fix) Fixed core dump that could occur if a syntax error -(such as missing close paren) occurred in an array reference with a -very long array name. (JO) - -3/4/96 (bug fix) Removed code in the "auto_load" procedure that deletes -all existing auto-load information whenever the "auto_path" variable -is changed. Instead, new information adds to what was already there. -Otherwise, changing the "auto_path" variable causes all package- -related information to be lost. If you really want to get rid of -existing auto-load information, use auto_reset before setting auto_path. (JO) - -3/5/96 (new feature) Added version suffix to shared library names so that -Tcl will compile under NetBSD and FreeBSD (I hope). (JO) - -3/6/96 (bug fix) Cleaned up error messages in new I/O system to correspond -more closely to old I/O system. (JO) - -3/6/96 (new feature) Added -myaddr and -myport options to the socket -command, removed -tcp and -- options. This lets clients and servers -choose a particular interface. Also changed the default server address -from the hostname to INADDR_ANY. The server accept callback now gets -passed the client's port as well as IP address. The C interfaces for -Tcl_OpenTcpClient and Tcl_OpenTcpServer have changed to support the -above changes. (BW) -*** POTENTIAL INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** - -3/6/96 (changed feature) The library function auto_mkindex will now -default to using the pattern "*.tcl" if no pattern is given. (RJ) - -3/6/96 (bug fix) The socket channel code for the Macintosh has been -rewritten to use native MacTcp. (RJ) - -3/7/96 (new feature) Added Tcl_SetStdChannel and Tcl_GetStdChannel -interfaces to allow applications to explicitly set and get the global -standard channels. (SS) - -3/7/96 (bug fix) Tcl did close not the file descriptors associated -with "stdout", etc. when the corresponding channels were closed. (SS) - -3/7/96 (bug fix) Reworked shared library and dynamic loading stuff to -try to get it working under AIX. Added new @SHLIB_LD_LIBS@ autoconf -symbol as part of this. AIX probably doesn't work yet, but it should -be a lot closer. (JO) - -3/7/96 (feature change) Added Tcl_ChannelProc typedef and changed the -signature of Tcl_CreateChannelHandler and Tcl_DeleteChannelHandler to take -Tcl_ChannelProc arguments instead of Tcl_FileProc arguments. This change -should not affect any code outside Tcl because the signatures of -Tcl_ChannelProc and Tcl_FileProc are compatible. (JL) - -3/7/96 (API change) Modified signature of Tcl_GetChannelOption to return -an int instead of char *, and to take a Tcl_DString * argument. Modified -the implementation so that the option name can be NULL, to mean that the -call should retrieve a list of alternating option names and values. (JL) -*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** - -3/7/96 (API change) Added Tcl_DriverSetOptionProc, Tcl_DriverGetOptionProc -typedefs, added two slots setOptionProc and getOptionProc to the channel -type structure. These may be NULL to indicate that the channel type does -not support any options. (JL) -*** INCOMPATIBILITY with Tcl 7.5b2, but not with Tcl 7.4 *** - -3/7/96 (feature change) stdin, stdout and stderr can now be put into -nonblocking mode. (JL) - -3/8/96 (feature change) Eliminated dependence on the registry for -finding the Tcl library files. (SS) - ------------------ Released 7.5b3, 3/8/96 ----------------------- - -3/12/96 (feature improvement) Modified startup script to look in several -different places for the Tcl library directory. This should allow Tcl -to find the libraries under all but the weirdest conditions, even without -the TCL_LIBRARY environment variable being set. (JO) - -3/13/96 (bug fix) Eliminated use of the "linger" option from the Windows -socket implementation. (JL) - -3/13/96 (new feature) Added -peername and -sockname options for fconfigure -for socket channels. Code contributed by John Haxby of HP. (JL) - -3/13/96 (bug fix) Fixed panic and core dump that would occur if the accept -callback script on a server socket encountered an error. (JL) - -3/13/96 (feature change) Added -async option to the Tcl socket command. -If the command is creating a client socket and the flag is present, the -client is connected asynchronously. If the option is absent (the default), -the client socket is connected synchronously, and the command returns only -when the connection has been completed or failed. This change was suggested -by Mark Diekhans. (JL) - -3/13/96 (feature change) Modified the signature of Tcl_OpenTcpClient to -take an additional int argument, async. If nonzero, the client is connected -to the server asynchronously. If the value is zero, the connection is made -synchronously, and the call to Tcl_OpenTcpClient returns only when the -connection fails or succeeds. This change was suggested by Mark Diekhans. (JL) -*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 *** - -3/14/96 (bug fix) "tclsh bogus_file_name" didn't print an error message. (JO) - -3/14/96 (bug fix) Added new procedures to tclCkalloc.c so that libraries -and applications can be compiled with TCL_MEM_DEBUG even if Tcl isn't -(however, the converse is still not true). Patches provided by Jan -Nijtmans. (JO) - -3/15/96 (bug fix) Marked standard IO handles of a process as close-on-exec -to fix bug in Ultrix where exec was not sharing standard IO handles with -subprocesses. Fix suggested by Mark Diekhans. (JL) - -3/15/96 (bug fix) Fixed asynchronous close mechanism so that it closes the -channel instead of leaking system resources. The manifestation was that Tcl -would eventually run out of file descriptors if it was handling a large -number of nonblocking sockets or pipes with high congestion. (JL) - -3/15/96 (bug fix) Fixed tests so that they no longer leak file descriptors. -The manifestation was that Tcl would eventually run out of file descriptors -if the tests were rerun many times (> a hundred times on Solaris). (JL) - -3/15/96 (bug fix) Fixed channel creation code so that it never creates -unnamed channels. This would cause a panic and core dump when the channel -was closed. (JL) - -3/16/96 (bug fixes) Made lots of changes in configuration stuff to get -Tcl working under AIX (finally). Tcl should now support the "load" -command under AIX and should work either with or without shared -libraries for Tcl and Tk. (JO) - -3/21/96 (configuration improvement) Changed configure script so it -doesn't use version numbers (as in -ltcl7.5 and libtcl7.5.so) under -SunOS 4.1, where they don't work anyway. (JO) - -3/22/96 (new feature) Added C API Tcl_InterpDeleted that allows extension -writers to discover when an interpreter is being deleted. (JL) - -3/22/96 (bug fix) The standard IO channels are now added to each -trusted interpreter as soon as the interpreter is created. This ensures -against the bug where a child would do IO before the master had done any, -and then the child is destroyed - the standard IO channels would be then -closed and the master would be unable to do any IO. (JL) - -3/22/96 (bug fix) Made Tcl more robust against interpreter deletion, by -using Tcl_Preserve, Tcl_Release and Tcl_EventuallyFree to split the process -of interpreter deletion into two distinct phases. Also went through all of -Tcl and added calls to Tcl_Preserve and Tcl_Delete where needed. (JL) - -3/22/96 (bug fix) Fixed several places where C code was reading and writing -into freed memory, especially during interpreter deletion. (JL) - -3/22/96 (bug fix) Fixed very deep bug in Tcl_Release that caused memory to -be freed twice if the release callback did Tcl_Preserve and Tcl_Release on -the same memory as the chunk currently being freed. (JL) - -3/22/96 (bug fix) Removed several memory leaks that would cause memory -buildup on half-K chunks in the generic IO level. (JL) - -3/22/96 (bug fix) Fixed several core dumps which occurred when new -AssocData was being created during the cleanups in interpreter deletion. -The solution implemented now is to loop repeatedly over the AssocData until -none is left to clean up. (JL) - -3/22/96 (bug fix) Fixed a bug in event handling which caused an infinite -loop if there were no files being watched and no timer. Fix suggested by -Jan Nijtmans. (JL) - -3/22/96 (bug fix) Fixed Tcl_CreateCommand, Tcl_DeleteCommand to be more -robust if the interpreter is being deleted. Also fixed several order -dependency bugs in Tcl_DeleteCommand which kicked in when an interpreter -was being deleted. (JL) - -3/26/96 (bug fix) Upon a "short read", the generic code no longer calls -the driver for more input. Doing this caused blocking on some platforms -even on nonblocking channels. Bug and fix courtesy Mark Roseman. (JL) - -3/26/96 (new feature) Added 'package Tcltest' which is present only in -test versions of Tcl; this allows the testing commands to be loaded into -new interpreters besides the main one. (JL) - -3/26/96 (restored feature) Recreated the Tcl_GetOpenFile C API. You can -now get a FILE * from a registered channel; Unix only. (JL) - -3/27/96 (bug fix) The regular expression code did not support more -than 9 subexpressions. It now supports up to 20. (SS) - -4/1/96 (bug fixes) The CHANNEL_BLOCKED bit was being left on on a short -read, so that fileevents wouldn't fire correctly. Bug reported by Mark -Roseman.(JL, RJ) - -4/1/96 (bug fix) Moved Tcl_Release to match Tcl_Preserve exactly, in -tclInterp.c; previously interpreters were being freed only conditionally -and sometimes not at all. (JL) - -4/1/96 (bug fix) Fixed error reporting in slave interpreters when the -error message was being generated directly by C code. Fix suggested by -Viktor Dukhovni of ESM. (JL) - -4/2/96 (bug fixes) Fixed a series of bugs in Windows sockets that caused -events to variously get lost, to get sent multiple times, or to be ignored -by the driver. The manifestation was blocking if the channel is blocking, -and either getting EAGAIN or infinite loops if the channel is nonblocking. -This series of bugs was found by Ian Wallis of Cisco. Now all tests (also -those that were previously commented out) in socket.test pass. (JL, SS) - -4/2/96 (feature change/bug fix) Eliminated network name support in -favor of better native name support. Added "file split", "file join", -and "file pathtype" commands. See the "file" man page for more -details. (SS) -*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 *** - -4/2/96 (bug fix) Changed implementation of auto_mkindex so tclIndex -files will properly handle path names in a cross platform context. (SS) - -4/5/96 (bug fix) Fixed Tcl_ReadCmd to use the channel buffer size as the -chunk size it reads, instead of a fixed 4K size. Thus, on large reads, the -user can set the channel buffer size to a large size and the read will -occur orders of magnitude faster. For example, on a 2MB file, reading in 4K -chunks took 34 seconds, while reading in 1MB chunks took 1.5 seconds (on a -SS-20). Problem identified and fix suggested by John Haxby of HP. (JL) - -4/5/96 (bug fix) Fixed socket creation code to invoke gethostbyname only if -inet_addr failed (very unlikely). Before this change the order was reversed -and this made things much slower than they needed to be (gethostbyname -generally requires an RPC, which is slow). Problem identified and fix -suggested by John Loverso of OSF. (JL) - -4/9/96 (feature change) Modified "auto" translation mode so that it -recognizes any of "\n", "\r" and "\r\n" in input as end of line, so -that a file can have mixed end-of-line sequences. It now outputs -the platform specific end of line sequence on each platform for files and -pipes, and for sockets it produces crlf in output on all platforms. (JL) -*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 *** - -4/11/96 (new feature) Added -eofchar option to Tcl_SetChannelOption to allow -setting of an end of file character for input and output. If an input eof -char is set, it is recognized as EOF and further input from the channel is -not presented to the caller. If an output eof char is set, on output, that -byte is appended to the channel when it is closed. On Unix and Macintosh, -all channels start with no eof char set for input or output. On Windows, -files and pipes start with input and output eof chars set to Crlt-Z (ascii -26), and sockets start with no input or output eof char. (JL) -*** INCOMPATIBILITY with Tcl 7.5b3, but not with Tcl 7.4 *** - -4/17/96 (bug fix) Fixed series of bugs with handling of crlf sequence split -across buffer boundaries in input, in AUTO mode. (JL, BW) - -4/17/96 (test suite improvement) Fixed test suite so that tests that -depend on the availability of Unix commands such as echo, cat and others -are not run if these commands are not present. (JL) - -4/17/96 (test suite improvement) The socket test now automatically starts, -on platformst that support exec, a separate process for remote testsing. (JL) - ------------------ Released 7.5, 4/21/96 ----------------------- - -5/1/96 (bug fix) "file tail ~" did not correctly return the tail -portion of the user's home directory. (SS) - -5/1/96 (bug fix) Fixed bug in TclGetEnv where it didn't lookup environment -variables correctly: could confuse "H" and "HOME", for example. (JO) - -5/1/96 (bug fix) Changed to install tclConfig.sh under "make install-binaries", -not "make install-libraries". (JO) - -5/2/96 (bug fix) Changed pkg_mkIndex not to attempt to "load" a file unless -it has the standard shared library extension. On SunOS, attempts to load -Tcl scripts cause the whole application to be aborted (there's no way to -get the error back into Tcl). (JO) - -5/7/96 (bug fix) Moved initScript in tclUnixInit.c to writable memory to -avoid potential core dumps. (JO) - -5/7/96 (bug fix) Auto_reset procedure was removing procedure from init.tcl, -such as pkg_mkIndex. (JO) - -5/7/96 (bug fix) Fixed cast on socket address resolution code that -would cause a failure to connect on Dec Alphas. (JL) - -5/7/96 (bug fix) Added "time", "subst" and "fileevent" commands to set of -commands available in a safe interpreter. (JL) - -5/13/96 (bug fix) Preventing OS level handles for stdin, stdout and stderr -from being implicitly closed when the last reference to the standard -channel containing that handle is discarded when an interpreter is deleted. -Explicitly closing standard channels by using "close" still works. (JL) - -5/21/96 (bug fix) Do not create channels for stdin, stdout and stderr on -Unix if the devices are closed. This prevents a duplicate channel name -panic later on when the fd is used to open a channel and the channel is -registered in an interpreter. (JL) - -5/23/96 (bug fix) Fixed bug that prevented the use of standard channels in -interpreters created after the last interpreter was destroyed. In the sequence - - interp = Tcl_CreateInterp(); - Tcl_DeleteInterp(interp); - interp = Tcl_CreateInterp(); - -channels for stdio would not be available in the second interpreter. (JL) - -5/23/96 (bug fix) Fixed bug that allowed Tcl_MakeFileChannel to create new -channels with Tcl_Files in them that are already used by another channel. -This would cause core dumps when the Tcl_Files were being freed twice. (JL) - -5/23/96 (bug fix) Fixed a logical timing bug that caused a standard channel -to be removed from the standard channel table too early when the channel -was being closed. If the channel was being flushed asynchronously, it could -get recreated before being actually destroyed, and the recreated channel -would contain the same Tcl_File as the one being closed, leading to -dangling pointers and core dumps. (JL) - -5/27/96 (bug fix) Fixed a bug in Tcl_GetChannelOption which caused it to -always return a list of one element, a list of the settings, for --translation and -eofchar options. Now correctly returns the value -described by the documentation (Mark Diekhans found this, thanks!). (JL) - -5/30/96 (bug fix) Fixed a couple of syntax errors in io.test. (JL) - -5/30/96 (bug fix) If a fileevent scripts gets an error, delete it before -causing a background error. This is to allow the error handler to reinstall -the fileevent and to prevent infinite loops if the event loop is reentered -in the error handler. (JL) - -5/31/96 (bug fix) Channels now will get properly flushed on exit. (JL) - -6/5/96 (bug fix) Changed Tcl_Ckalloc, Tcl_Ckfree, and Tcl_Ckrealloc to -Tcl_Alloc, Tcl_Free, and Tcl_Realloc. Added documentation for these -routines now that they are officially supported. Extension writers -should use these routines instead of free() and malloc(). (SS) - -6/10/96 (bug fix) Changes the Tcl close command so that it no longer -waits on nonblocking pipes for the piped processes to exit; instead it -reaps them in the background. (JL) - -6/11/96 (bug fix) Increased the length of the listen queue for server -sockets on Unix from 5 to 100. Some OSes will disregard this and reset it -to 5, but we should try to get as long a queue as we can, for performance -reasons. (JL) - -6/11/96 (bug fix) Fixed windows sockets bug that caused a cascade of events -if the fileevent script read less than was available. Now reading less than -is available does not cause a flood of Tcl events. (JL, SS) - -6/11/96 (bug fix) Fixed bug in background flushing on closed channels that -would prevent the last buffer from getting flushed. (JL) - -6/13/96 (bug fix) Fixed bug in Windows sockets that caused a core dump if -a DLL linked with tcl.dll and referred to e.g. ntohs() without opening a -Tcl socket. The problem was that the indirection table was not being -initialized. (JL) - -6/13/96 (bug fix) Fixed OS level resource leak that would occur when a -Tcl channel was still registered in some interpreter when the process -exits. Previously the channel was not being closed and the OS level handles -were not being released; the output was being flushed but the device was -not being closed. Now the device is properly closed. This was only a -problem on Win3.1 and MacOS. (JL, SS) - -6/28/96 (bug fix) Fixed bug where transient errors were leaving an error -code around, so that it would erroneously get reported later. This bug was -exercised intermittently by closing a channel to a file on a very loaded -NFS server, or to a socket whose other end blocked. (JL, BW) - -7/3/96 (bug fix) Fileevents declared in an interpreter are now deleted -when the channel is closed in that interpreter. Before this fix, the -fileevent would hang around until the channel is completely closed, and -would cause errors if events happened before the channel was closed. This -could happen in two cases: first if the channel is shared between several -interpreters, and second if an async flush is in progress that prevents the -channel from being closed until the flush finishes. (JL) - -7/10/96 (bug fix) Fixed bugs in both "lrange" and "lreplace" commands -where too much white space was being removed. For example, the command - lreplace {\}\ hello} end end -was returning "\}\", losing the significant space in the first list -element and corrupting the list. (JO) - -7/20/96 (bug fix) The procedure pkg_mkIndex didn't work properly for -extensions that depend on Tk, because it didn't load Tk into the child -interpreter before loading the extension. Now it loads Tk if Tk is -present in the parent. (JO) - -7/23/96 (bug fix) Added compat version of strftime to fix crashes -resulting from bad implementations under Windows. (SS) - -7/23/96 (bug fix) Standard implementations of gmtime() and localtime() -under Windows did not handle dates before 1970, so they were replaced -with a revised implementation. (SS) - -7/23/96 (bug fix) Tcl would crash on exit under Borland 5.0 because -the global environ pointer was left pointing to freed memory. (SS) - -7/29/96 (bug fix) Fixed memory leak in Tcl_LoadCmd that could occur if -a package's AppInit procedure called Tcl_StaticPackage to register -static packages. (JO) - -8/1/96 (bug fix) Fixed a series of bugs in Windows sockets so that async -writebehind in the presence of read event handlers now works, and so that -async writebehind also works on sockets for which a read event handler was -declared and whose channels were then closed before the async write -finished. The bug was reported by John Loverso and Steven Wahl, -independently, test case supplied by John Loverso. (JL) - ------------------ Released patch 7.5p1, 8/2/96 ----------------------- - -5/8/96 (new feature) Added Tcl_GetChannelMode C API for retrieving whether -a channel is open for reading and writing. (JL) - -5/8/96 (API changes) Revised C APIs for channel drivers: - - Removed all Tcl_Files from channel driver interface; you can now have - channels that are not based on Tcl_Files. - - Added channelReadyProc and watchChannelProc procedures to interface; - these are used to implement event notification for channels. - - Added getFileProc to channel driver, to allow the generic IO code - to retrieve a Tcl_File from a channel (presumably if the channel - uses Tcl_Files they will be stored inside its instanceData). (JL) -*** INCOMPATIBILITY with Tcl 7.5 *** - -5/8/96 (API change) The Tcl_CreateChannel C API was modified to not take -Tcl_File arguments, and instead to take a mask specifying whether the -channel is readable and/or writable. (JL) -*** INCOMPATIBILITY with Tcl 7.5 *** - -6/3/96 (bug fix) Made Tcl_SetVar2 robust against the case where the value -of the variable is a NULL pointer instead of "". (JL) - -6/17/96 (bug fix) Fixed "reading uninitialized memory" error reported by -Purify, in Tcl_Preserve/Tcl_Release. (JL) - -8/9/96 (bug fix) Fixed bug in init.tcl that caused incorrect error message -if the act of autoloading a procedure caused the procedure to be invoked -again. (JO) - -8/9/96 (bug fix) Configure script produced bad library names and extensions -under SunOS and a few other platforms if the --disable-load switch was used. -(JO) - -8/9/96 (bug fix) Tcl_UpdateLinkedVar generated an error if the variable -being updated was read-only. (JO) - -8/14/96 (bug fix) The macintosh now supports synchronous socket -connections. Other minor bugs were also fixed. (RJ) - -8/15/96 (configuration improvement) Changed the file patchlevel.h -to be tclPatch.h. This avoids conflict with the Tk file and is now -in 8.3 format on the Windows platform. (RJ) - -8/20/96 (bug fix) Fixed core dump in interp alias command for interpreters -created with Tcl_CreateInterp (as opposed to with Tcl_CreateSlave). (JL) - -8/20/96 (bug fix) No longer masking ECONNRESET on Windows sockets so -that the higher level of the IO mechanism sees the error instead of -entering an infinite loop. (JL) - -8/20/96 (bug fix) Destroying the last interpreter no longer closes the -standard channels. (JL) - -8/20/96 (bug fix) Closing one of the stdin, stdout or stderr channels and -then opening a new channel now correctly assigns the new channel as the -standard channel that was closed. (JL) - -8/20/96 (bug fix) Added code to unix/tclUnixChan.c for using ioctl with -FIONBIO instead of fcntl with O_NONBLOCK, for those versions of Unix where -either O_NONBLOCK is not supported or implemented incorrectly. (JL) - -8/21/96 (bug fix) Fixed "file extension" so it correctly returns the -extension on files like "foo..c" as "..c" instead of ".c". (SS) - -8/22/96 (bug fix) If environ[] contains static strings, Tcl would core -dump in TclSetupEnv because it was trying to write NULLs into the actual -data in environ[]. Now we instead copy as appropriate. (JL) - -8/22/96 (added impl) Added missing implementation of Tcl_MakeTcpClientChannel -for Windows platform. Code contributed by Mark Diekhans. (JL) - -8/22/96 (new feature) Added a new memory allocator for the Macintosh -version of Tcl. It's quite a bit faster than MetroWerk's version. (RJ) - -8/26/96 (documentation update) Removed old change bars (for all changes -in Tcl 7.5 and earlier releases) from manual entries. (JO) - -8/27/96 (enhancement) The exec and open commands behave better and work in -more situations under Windows NT and Windows 95. Documentation describes -what is still lacking. (CS) - -8/27/96 (enhancement) The Windows makefiles will now compile even if the -compiler is not in the path and/or the compiler's environment variables -have not been set up. (CS) - -8/27/96 (configuration improvement) The Windows resource files are -automatically updated when the version/patch level changes. The header file -now has a comment that reminds the user which other files must be manually -updated when the version/patch level changes. (CS) - -8/28/96 (new feature) Added file manipulation features (copy, rename, delete, -mkdir) that are supported on all platforms. They are implemented as -subcommands to the "file" command. See the documentation for the "file" -command for more information. (JH) - ------------------ Released 7.6b1, 8/30/96 ----------------------- - -9/3/96 (bug fix) Simplified code so that standard channels are created -lazily, they are added to an interpreter lazily, and they are never added -to a safe interpreter. (JL) - -9/3/96 (bug fix) Closing a channel after closing a standard channel, e.g. -stdout, would cause the implicit recreation of that standard channel. (JL) - -9/3/96 (new feature) Now calling Tcl_RegisterChannel with a NULL -interpreter increments the refcount so that code outside any interpreter -can use channels that are also registered in interpreters, without worrying -that the channel may turn into a dangling pointer at any time. Calling -Tcl_UnregisterChannel with a NULL interpreter only decrements the recount -so that code outside any interpreter can safely declare it is no longer -interested in a channel. (JL) - -9/4/96 (new features) Two changes to dynamic loading: - - If the file name is empty in the "load" command and there is no - statically loaded version of the package, a dynamically loaded - version will be used if there is one. - - Tcl_StaticPackage ignores redundant calls for the same package. (JO) - -9/6/96 (bug fix) Platform specific procedures for manipulating files are -no longer macros and have been prefixed with "Tclp", such as TclpRenameFile. -Unix file code now handles symbolic links and other special files correctly. -The semantics of file copy and file rename has been changed so that if -a target directory exists, the source files will NOT be merged with the -existing files. (JH) - -9/6/96 (bug fix) If standard channel is NULL, because Tcl cannot connect -to the standard channel, do not increment the refcount. The channel can -be NULL if there is for example no standard input. (JL) - -9/6/96 (portability improvement) Changed parsing of backslash sequences -like \n to translate directly to absolute values like 0xA instead of -letting the compiler do the translation. This guarantees that the -translation is done the same everywhere. (JO) - -9/9/96 (bug fix) If channel is opened and not associated with any -interpreter, but Tcl decides to use it as one of the standard channels, it -became impossible to close the channel with Tcl_Close -- instead you had -to call Tcl_UnregisterChannel. Fixed now so that it's safe to call -Tcl_Close even when Tcl is using the channel as one of the standard ones. (JL) - -9/11/96 (feature change) The Tcl library is now placed in the Tcl -shared libraries resource. You no longer need to place the Tcl files -in your applications explicitly. (RJ) - -9/11/96 (feature change) Extensions no longer automatically have the -resource fork of the extension opened for it. Instead you need to -use the tclMacLibrary.c file in your extension. (RJ) -*** POTENTIAL INCOMPATIBILITY *** - -9/12/96 (bug fix) The extension loading mechanism on the Macintosh now -looks at the 'cfrg' resource to determine where to load the code -fragment from. This means FAT fragments should now work. (RJ) - -9/18/96 (enhancement) The exec and open commands behave better and work in -more situations under Windows 3.X. Documentation describes what is still -lacking. (CS) - -9/19/96 (bug fix) Fixed a panic which would occur if you delete a -non-existent alias before any aliases are created. Now instead correctly -returns an error that the alias is not found. (JL) - -9/19/96 (bug fix) Slave interpreters could rename aliases and they would -not get deleted when the alias was being redefined. This led to dangling -pointers etc. (JL) - -9/19/96 (bug fix) Fixed a panic where a hash table entry was being deleted -twice during alias management operations. (JL) - -9/19/96 (bug fix) Fixed bug in event loop that could cause the input focus -in Tk to get confused during menu traversal, among other problems. The -problem was related to handling of the "marker" when its event was -deleted. (JO) - -9/26/96 (bug fix) Windows was losing EOF on a socket if the FD_CLOSE event -happened to precede any left over FD_READ events. Now correctly remembers -seeing FD_CLOSE, so that trailing FD_READ events are not discarded if they -do not contain any data. This allows Tcl to correctly get a zero read and -notice EOF. (JL) - -9/26/96 (bug fix) Was not resetting READABLE state properly on sockets -under Windows if the driver discarded an FD_READ event because no data was -present. Now correctly resets the state. (JL) - -9/30/96 (bug fix) Made EOF sticky on Windows sockets, so that fileevent -readable will fire repeatedly until the socket is closed. Previously the -fileevent fired only once. This could lead to never-closed connections if -the Tcl script in the fileevent wasn't closing the socket immediately. (JL) - -10/2/96 (new feature) Improved the package loader: - - Added new variable tcl_pkgPath, which holds the default - directories under which packages are normally installed (each - package goes in a separate subdirectory of a directory in - $tcl_pkgPath). These directories are included in auto_path by - default. - - Changed the package auto-loader to look for pkgIndex.tcl files - not only in the auto_path directories but also in their immediate - children. This should make it easier to install and uninstall - packages (don't have to change auto_path or merge pkgIndex.tcl - files). (JO) - -10/3/96 (bug fix) Changed tclsh to look for tclshrc.tcl instead of -tclsh.rc on startup under Windows. This is more consistent with wish and -uses the right extension. (SS) -*** POTENTIAL INCOMPATIBILITY *** - -10/8/96 (bug fix) Convertclock does not parse 24-hour times of the -form "hhmm" correctly when hour = 00. In the parse code, hour must be ->= 100 for minutes to be non-zero. Thanks to Lint LaCour for this -bug fix. (RJ) - -10/11/96 (bug fix) Under Windows, the pid command returned the process -handle instead of the process id. (SS) - ------------------ Released 7.6, 10/16/96 ----------------------- - -10/29/96 (bug fix) Under Windows, sockets would consume 100% CPU time after -the first accept(), due to a typo. (JL) - -10/29/96 (bug fix) Incorrect refcount management caused standard channels -not to get deleted at process exit or DLL unload time, causing a memory -leak of upwards of 20K each time. (JL) - -11/7/96 (bug fix) Auto-exec didn't work on file names that contained -spaces. (JO) - -11/8/96 (bug fix) Fixed core dump that would occur if more than one call -to Tcl_DeleteChannelHandler was made to delete a given channel handler. (JL) - -11/8/96 (bug fix) Fixed test for return value in Tcl_Seek and Tcl_SeekCmd -to only treat -1 as error, instead of all negative numbers. (JL) - -11/12/96 (bug fix) Do not blocking waiting for processes at the end of a -pipe during exit cleanup. (JL) - -11/12/96 (bug fix) If we are in exit cleanup, do not close the system level -file descriptors 0, 1 and 2. Previously they were being closed which is -incorrect, in the embedded case. This led to weird behavior for programs -that want to interpose on I/O through the standard file descriptors (e.g. -Netscape Navigator). (JL) - -11/15/96 (bug fix) Fixed core dump on Windows sockets due to dependency on -deletion order at exit. Now all socket functions check to see if sockets -are (still) initialized, before calling through function pointers. Before, -they would call and might end up calling unloaded object code. (JL) - -11/15/96 (bug fix) Fixed core dump in Windows socket initialization routine -if sockets were not installed on the system. Before, it was not properly -checking the result of attempting to load the socket DLL, so it would call -through uninitialized function pointers. (JL) - -11/15/96 (bug fix) Fixed memory leak in Windows sockets which left socket -DLL handle open and could hold the socket DLL in memory uneccessarily, -until a reboot. (JL) - -12/4/96 (bug fix) Fixed bug in Macintosh socket code that could result -in lost data if a client was closed too soon after sending data. (RJ) - -12/17/96 (bug fix) Fixed deadlock bug in Windows sockets due to losing an -event. This was happening because of an interaction between buffering and -nonblocking mode on sockets. Now switched to sockets being blocking by -default, so we are also no longer emulating blocking through a private -event loop. (JL) - -1/21/97 (performance bug fix) Client TCP connections were slow to create -because getservbyname was always called on the port. Now this is only -done if Tcl_GetInt fails. (BW) - -1/21/97 (configuration fix) Made it possible to override TCL_PACKAGE_PATH -during make. Previously it was only set during autoconf process. - -1/29/97 (bug fix) Fixed some problems with the clock command that -impacted how dates were scaned after the year 2000. (RJ) - ------------------ Released 7.6p2, 1/31/97 ----------------------- - -2/5/97 (bug fix) Fixed a bug where in CR-LF translation mode, \r bytes -in the input stream were not being handled correctly. (JL) - -2/24/97 (bug fix) Fix bug with exec under Win32s not being able to create -stderr file which caused all execs to fail. Fixed temp file leak under -Win32s. Fixed optional parameter bug with SearchPath that only happened -under Win32s 1.25. (CCS) - ----------------------------------------------------------- -Changes for Tcl 7.6 go above this line. -Changes for Tcl 7.7 go below this line. ----------------------------------------------------------- - -5/8/96 (new feature) Added Tcl_Ungets C API for putting a sequence of bytes -into a channel's input buffer. This can be used for "push" model channels -where the input is obtained via callbacks instead of by request of the -generic IO code. No Tcl procedure yet. (JL) - -11/15/96 (new feature) Implemented hidden commands. New C APIs: - Tcl_HideCommand -- hides an existing exposed command. - Tcl_ExposeCommand -- exposes an existing hidden command. -New tcl APIs: - interp invokehidden -- invokes a hidden command in a slave. - interp hide -- hides an existing exposed command. - interp expose -- exposes an existing hidden command. - interp hidden -- returns a list of hidden commands. -The implementation of Safe Tcl now uses the new hidden commands facility -to implement the safe base, instead of deleting the commands from a safe -interpreter. (JL) - -11/15/96 (new feature) Implemented the safe base, a mechanism for -installing and requesting security policies, purely in Tcl code. Overloads -the package command to also allow an interpreter to "require" a policy. The -following new library commands are provided: - tcl_safeCreateInterp -- creates a slave and initializes the - policy mechanism. - tcl_safeInitInterp -- initializes an existing slave with the - policy mechanism. - tcl_safeDeleteInterp -- deletes a slave and deinitializes the - policy mechanism. -Added a new file to the library, safeinit.tcl, to hold implementation. (JL) -On 7/9/97, removed the policy loading mechanism from the Safe Base. Left -only the Safe Base aliases dealing with auto-loading and source. (JL) - -12/6/96 (new feature) Implemented Tcl_Finalize, an API that should be -called by a process when it is done using Tcl. This API runs all the exit -handlers to allow them to clean up resources etc. (JL) - -12/17/96 (new feature) Add an http Tcl script package to the Tcl library. -This package implements the client side of HTTP/1.0; the GET, HEAD, -and POST requests. (BW) - -1/21/97 (new feature) Added a "marktrusted" subcommand to the "interp" and -to the interpreter object command. It removes the "safe" mark on an -interpreter and disables hard-wired checks for safety in the C sources. (JL) - -1/21/97 (removed feature) Removed "vwait" from set of commands available in -a safe interpreter. (JL) - -2/11/97 (new feature, bug fix) http package. Added -accept to http_config -so you can set the Accept header. Added -handler option to http_get so -you can supply your own data handler. Also fixed POST operation to -set the correct MIME type on the request. (BW) - ----------------------------------------------------------- -Changes for Tcl 7.7 go above this line. -Changes for Tcl 8.0 go below this line. ----------------------------------------------------------- - -9/17/96 (bug fix) Using "upvar" it was possible to turn an array element -into an array itself. Changed to disallow this; it was quirky and didn't -really work correctly anyway. (JO) - -10/21/96 (new feature) The core of the Tcl interpreter has been replaced -with an on-the-fly compiler that translates Tcl scripts to bytecoded -instructions; a new interpreter then executes the bytecodes. The compiler -introduces only a few minor changes at the level of Tcl scripts. The biggest -changes are to expressions and lists. - - A second level of substitutions is no longer done for expressions. - This substantially improves their execution time. This means that - the expression "$x*4" produces a different result than in the past - if x is "$y+2". Fortunately, not much code depends on the old - two-level semantics. Some expressions that do, such as - "expr [join $list +]" can be recoded to work in Tcl8.0 by adding - an eval: e.g., "eval expr [join $list +]". - - Lists are now completely parsed on the first list operation to - create a faster internal representation. In the past, if you had a - misformed list but the erroneous part was after the point you - inserted or extracted an element, then you never saw an error. - In Tcl8.0 an error will be reported. This should only effect - incorrect programs that took advantage of behavior of the old - implementation that was not documented in the man pages. -Other changes to Tcl scripts are discussed in the web page at -http://www.scriptics.com/doc/compiler.html. (BL) -*** POTENTIAL INCOMPATIBILITY *** - -10/21/96 (new feature) In earlier versions of Tcl, strings were used as a -universal representation; in Tcl 8.0 strings are replaced with Tcl_Obj -structures ("objects") that can hold both a string value and an internal -form such as a binary integer or compiled bytecodes. The new objects make it -possible to store information in efficient internal forms and avoid the -constant translations to and from strings that occurred with the old -interpreter. There are new many new C APIs for managing objects. Some of the -new library procedures for objects (such as Tcl_EvalObj) resemble existing -string-based procedures (such as Tcl_Eval) but take advantage of the -internal form stored in Tcl objects for greater speed. Other new procedures -manage objects and allow extension writers to define new kinds of objects. -See the manual entries doc/*Obj*.3 (BL) - -10/24/96 (bug fix) Fixed memory leak on exit caused by some IO related -data structures not being deallocated on exit because their refcount was -artificially boosted. (JL) - -10/24/96 (bug fix) Fixed core dump in Tcl_Close if called with NULL -Tcl_Channel. (JL) - -11/19/96 (new feature) Added library procedures for finding word -breaks in strings in a platform specific manner. See the library.n -manual entry for more information. (SS) - -11/22/96 (feature improvements) Added support for different levels of -tracing during bytecode compilation and execution. This should help in -tracking down suspected problems with the compiler or with converting -existing code to use Tcl8.0. Two global Tcl variables, traceCompile -and traceExec, can be set to generate tracing information in stdout: - - traceCompile: 0 no tracing (default) - 1 trace compilations of top level commands and procs - 2 trace and display instructions for all compilations - - traceExec: 0 no tracing - 1 trace only calls to Tcl procs - 2 trace invocations of all commands including procs - 3 detailed trace showing the result of each instruction -traceExec >= 2 provides a one line summary of each called command and -its arguments. Commands that have been "compiled away" such as set are -not shown. (BL) - -11/30/96 (bug fix) The command "info nameofexecutable" could sometimes -return the name of a directory. (JO) - -11/30/96 (feature improvements) Changed the code in library/init.tcl -that reads in pkgIndex.tcl so that (a) it reads the files from child -directories before those in the parent, so that the parent gets -precedence, and (b) it doesn't quit if there is an error in a -pkgIndex.tcl file; instead, it prints an error message on standard -error and continues. (JO) - -10/5/96 (feature improvements) Partial implementation of binary string -support: the ability for Tcl string values to contain embedded null bytes. -Changed the Tcl object-based APIs to take a byte pointer and length pair -instead of a null-terminated C string. Modified several object type managers -to support binary strings but not, for example, the list type manager. -Existing string-based C APIs are unchanged and will truncate binary -strings. Compiled scripts containing nulls are also truncated. (BL) - -12/12/96 (feature change) Removed the commands "cp", "mkdir", "mv", -"rm", and "rmdir" from the Macintosh version of Tcl. They were never -officially supported and their functionality is now available via -the file command. (RJ) - ------------------ Released 8.0a1, 12/20/96 ----------------------- - -1/7/97 (bug fix) Under Windows, "file stat c:" was returning error instead -of stat for current dir on c: drive. - -1/10/97 (new feature) Added Tcl_GetIndexFromObj procedure for quick -lookups of keyword arguments. (JO) - -1/12/97 (new feature) Serial IO channel drivers for Windows and Unix, -available by using Tcl open command to open pseudo-files like "com1:" or -"/dev/ttya". New option to Tcl fconfigure command for serial files: -"-mode baud,parity,data,stop" to specify baud rate, parity, data bits, and -stop bits. Serial IO is not yet available on Mac. - -1/16/97 (feature change) Restored the Tcl7.x "two level substitution -semantics" for expressions. Expressions not enclosed in braces are -implemented, in general, by calling the expr command procedure -(Tcl_ExprObjCmd) at runtime after the Tcl interpreter has already done a -first round of substitutions. This is slow (about Tcl7.x speed) because new -code for the expression is generally compiled each time. However, if the -expression has only variable substitutions (and not command substitutions), -"optimistic" fast code is generated inline. This inline code will fail if a -second round of substitutions is needed (i.e., if the value of a substituted -variable itself requires more substitutions). The optimistic code will -catch the error and back off to call the slower but guaranteed correct -expr command procedure. (BL) - -1/16/97 (feature improvements) Added Tcl_ExprLongObj and Tcl_ExprDoubleObj -to round out expression-related procedures. (BL) - -1/16/97 (feature change) Under Windows, at startup the environment variables -"path", "comspec", and "windir" in any capitalization are converted -automatically to upper case. The PATH variable could be spelled as path, -Path, PaTh, etc. and it makes programming rather annoying. All other -environment variables are left alone. (CS) - -1/20/97 (new features) Rewrote the "lsort" command: - - The new version is based on reentrant merge sort code provided - by Richard Hipp, so it eliminates the reentrancy and stability - problems with the old qsort-based implementation. - - The new version supports a -dictionary option for sorting, and - it also supports a -index option for sorting lists using one - element for comparison. - - The new version is an object command, so it works well with the - Tcl compiler, especially in conjunction with the new -index - option. When the -index option is used, this version of lsort - is more than 100 times faster than the Tcl 7.6 lsort, which had - to use the -command option to get the same effect. (JO) - -1/20/97 (feature improvements) Added the improved debugging support for Tcl -objects prototyped by Karl Lehenbauer . -If TCL_MEM_DEBUG is defined, the object creation calls use Tcl_DbCkalloc -directly in order to record the caller's source file name and line -number. (BL) - -1/21/97 (removed feature) Desupported the tcl_precision variable: if -set, it is ignored. Tcl now uses the full 17 digits of precision when -converting real numbers to strings (with the new object system real -numbers are rarely converted to strings so there is no efficiency -disadvantage to printing all 17 digits; the new scheme improves -accuracy and simplifies several APIs). (JO) -*** POTENTIAL INCOMPATIBILITY *** - -1/21/97 (feature change) Removed the "interp" argument for the -procedures Tcl_GetStringFromObj, Tcl_StringObjAppend, and -Tcl_StringObjAppendObj. Also removed the "interp" argument for -the updateStringProc procedure in Tcl_ObjType structures. With -the tcl_precision changes above, these are no longer needed. (JO) -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a1, but not with Tcl 7.6 *** - -1/22/97 (bug fix) Fixed http.tcl so that http_reset does not result in -an extra call to the command callback. In addition, if the transaction -gets a premature eof, the state(status) is "eof", not "ok". (BW) - ------------------ Released 8.0a2, 1/24/97 ----------------------- - -1/29/97 (feature change) Changed how two digit years are parsed in the -clock command. The old interface just added 1900 which will seem -broken by the year 2000. The new scheme follows the POSIX standard -and treats dates 70-99 as 1970-1999 and dates 00-38 as 2000-2038. All -other two digit dates are undefined. (RJ) -*** POTENTIAL INCOMPATIBILITY *** - -2/4/97 (bug fix) Fixed bug in clock code that dealt with relative -dates. Using the relative month code you could get an invalid date -because it jumped into a non-existant day. (For example, Jan 31 -to Feb 31.) The code now will return the last valid day of the -month in these situations. Thanks to Hume Smith for sending in -this bug fix. (RJ) - -2/10/97 (feature change) Eliminated Tcl_StringObjAppend and -Tcl_StringObjAppendObj procedures, replaced them with Tcl_AppendToObj -and Tcl_AppendStringsToObj procedures. Added new procedure -Tcl_SetObjLength. (JO) -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2, but not with Tcl 7.6 *** - -2/10/97 (new feature) Added Tcl_WrongNumArgs procedure for generating -error messages about incorrect number of arguments. (JO) - -2/11/97 (new feature, bug fix) http package. Added -accept to http_config -so you can set the Accept header. Added -handler option to http_get so -you can supply your own data handler. Also fixed POST operation to -set the correct MIME type on the request. (BW) - -2/22/97 (bug fix) Fixed bug that caused $tcl_platform(osVersion) to be -computed incorrectly under AIX. (JO) - -2/25/97 (new feature, feature change) Added support for both int and long -integer objects. Added Tcl_NewLongObj/Tcl_GetLongFromObj/Tcl_SetLongFromObj -procedures and renamed the Tcl_Obj internalRep intValue member to -longValue. Tcl_GetIntFromObj now checks for integer values too large to -represent as non-long integers. Changed Tcl_GetAllObjTypes to -Tcl_AppendAllObjTypes. (BL) - -3/5/97 (new feature) Added new Tcl_SetListObj procedure to round out -collection of procedures that set the type and value of existing Tcl -objects. (BL) - -3/6/97 (new feature) Added -global flag for interp invokehidden. (JL) - -3/6/97 (new feature, feature change) Added isNativeObjectProc field to the -Tcl_CmdInfo structure to indicate (when 1) if the command has an -object-based command procedure. Removed the nameLength arg from -Tcl_CreateObjCommand since command names can't contain null characters. (BL) - -3/6/97 (bug fix) Fixed bug in "unknown" procedure that caused auto- -loading to fail on commands whose names begin with digits. (JO) - -3/7/97 (bug fix) Auto-loading now works in Safe Base. Safe interpreters -only accept the Version 2 and onwards tclIndex files. (JL) - -3/13/97 (bug fix) Fixed core dump due to interaction between aliases and -hidden commands. Bug found by Lindsay Marshall. (JL) - -3/14/97 (bug fix) Fixed mac bugs relating to time. The -gmt option -now adjusts the time in the correct direction. (Thanks to Ed Hume for -reporting a fix to this problem.) Also fixed file "mtime" etc. to -return times from GMT rather than local time zone. (RJ) - -3/18/97 (feature change) Declaration of objv in Tcl_ObjCmdProc function -changed from "Tcl_Obj *objv[]" to "Tcl_Obj *CONST objv[]". All Tcl object -commands changed to use new declaration of objv. Naive translation of -string-based command procs to object-based command procs could very easily -have yielded code where the contents of the objv array were changed. This -is not a problem with string-based command procs, but doing something as -simple as objv[2] = objv[3] would corrupt the runtime stack and cause Tcl to -crash. Introduced CONST in declaration of objv so that attempted assignment -of new pointer values to elements of the objv array will be caught by the -compiler. (CCS) -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 *** - -3/19/97 (bug fix) Fixed panic due to object sharing. The root cause was -that old code was using Tcl_ResetResult instead of Tcl_ResetObjResult. (JL) - -3/20/97 (new feature) Added a new subcommand for the file -command. file attributes filename can give a list of platform-specific -options (such as file/creator type on the Mac, permissions on Unix) or -set the values of them. Added a new subcommand for the file -command. file nativename name gives back the platform-specific form -for the file. This is useful when the filename is needed to pass to -the OS, such as exec under Windows 95 or AppleScript on the Mac. For -more info, see file.n. (SRP) - -3/24/97 (removed feature) Removed the tcl_safePolicyPath procedure. Now -the policy path is computed from the auto_path by appending the directory -'policies' to each element. Also fixed several bugs in automatic tracking -of auto_path by computed policy path. (JL) -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 but not with Tcl 7.6 *** - -4/8/97 (new feature) If the variable whose name is passed to lappend doesn't -already exist, and there are no value arguments, lappend now creates the -variable with an empty value instead of returning an error. Change suggested -by Tom Tromey. (BL) - -4/9/97 (feature change) Changed the name of the TCL_PART1_NOT_PARSED flag to -TCL_PARSE_PART1. (BL) -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 but not with Tcl 7.6 *** - -4/10/97 (bug fixes) Fixed various compilation-related bugs: - - "UpdateStringOfCmdName should never be invoked" panic. - - Bad code generated for expressions not in {}'s inside catch commands. - - Segmentation fault in some command procedures when two argument - object pointers refer to the same object. - - Second level of substitutions were never done for expressions not - in {}'s that consist of a single variable reference: e.g., - "set x 27; set bool {$x}; if $bool {puts foo}" would fail with error. - - Bad code generated when code storage was grown while compiling some - expressions: ones with compilation errors or consisting of only a - variable reference. - - Bugs involving multiple interpreters: wasn't checking that a - procedure's code was compiled for the same interpreter as the one - executing it, and didn't invalidate code on hidden-exposed command - transitions. - - "Bad stack top" panic when executing scripts that require a huge - amount of stack space. - - Incorrect sharing of code for procedure bodies, and procedure code - deallocated before last execution of the procedure finished. - - Fixed compilation of expression words in quotes. For example, - if "0 < 3" {puts foo}. - - Fixed performance bug in array set command with large assignments. - - Tcl_SetObjLength segmentation fault setting length of empty object. - - If Tcl_SetObjectResult was passed the same object as the interpreter's - result object, it freed the object instead of doing nothing. Bug fix - by Michael J. McLennan. - - Tcl_ListObjAppendList inserted elements from the wrong list. Bug fix - by Michael J. McLennan. - - Segmentation fault if empty variable list was specified in a foreach - command. Bug fix by Jan Nijtmans. - - NULL command name was always passed to Tcl_CreateTrace callback - procedure. - - Wrong string representation generated for the value LONG_MIN. - For example, expr 1<<31 printed incorrectly on a 32 bit machine. - - "set {a($x)} 1" stored value in wrong variable. - - Tcl_GetBooleanFromObj was not checking for garbage after a numeric - value. - - Garbled "bad operand type" error message when evaluating expressions - not surrounded by {}'s. (BL) - -4/16/97 (new feature) The expr command now has the "rand()" and -"srand()" functions for getting random numbers in expr. (RJ) - -4/23/97 (bug fix) Fixed core dump in bgerror when the error handler command -deletes the current interpreter. Found by Juergen Schoenwald. (JL) - -4/23/97 (feature change) The notifier interfaces have been redesigned -to make embedding in applications with external event loops possible. -A number of interfaces in the notifier and the channel drivers have -changed. Refer to the Notifier.3 and CrtChannel.3 manual entries for -more details. (SS) -*** POTENTIAL INCOMPATIBILITY *** - -4/23/97 (removed feature) The Tcl_File interfaces have been removed. -The Tcl_CreateFileHandler/Tcl_DeleteFileHandler interfaces now take -Unix fd's and are only supported on the Unix platform. -Tcl_GetChannelFile has been replaced with Tcl_GetChannelHandle. -Tcl_MakeFileChannel now takes a platform specific file handle. (SS) -*** POTENTIAL INCOMPATIBILITY *** - -4/23/97 (removed feature) The modal timeout interface has been -removed (Tcl_CreateModalTimeout/Tcl_DeleteModalTimeout) (SS) -*** POTENTIAL INCOMPATIBILITY *** - -4/23/97 (feature change) Channel drivers are now required to correctly -implement blocking behavior when they are in blocking mode. (SS) -*** POTENTIAL INCOMPATIBILITY *** - -4/23/97 (new feature) Added the "binary" command for manipulating -binary strings. Also, changed the "puts", "gets", and "read" commands -to preserve embedded nulls. (SS) - -4/23/97 (new feature) Added tcl_platform(byteOrder) element to the -tcl_platform array to identify the native byte order for the current -host. (SS) - -4/23/97 (bug fix) Fixed bug in date parsing around year boundaries. (SS) - -4/24/97 (bug fix) In the process of copying a file owned by another user, -Tcl was changing the owner of the copy back to the owner of the original -file, therefore causing further file operations to fail because the current -user didn't own the copy anymore. The owner of the copy is now left as the -current user. (CCS) - -4/24/97 (feature change) Under Windows, don't automatically uppercase the -environment variable "windir" -- it's supposed to be lower case. (CCS) - -4/29/97 (new feature) Added namespace support based on a namespace -implementation by Michael J. McLennan of Lucent Technologies. A namespace -encapsulates a collection of commands and variables to ensure that they -won't interfere the commands and variables of other namespaces. The global -namespace holds all global variables and commands. Additional namespaces are -created with the new namespace command. The new variable command lets you -create Tcl variables inside a namespace. The names of Tcl variables and -commands may now be qualified by the name of the namespace containing them. -The key namespace-related commands are summarized below: - - namespace ?eval? name arg ?arg...? - Used to define the commands and variables in a namespace. - Optionally creates the namespace. - - namespace export ?-clear? ?pattern pattern...? - Specifies which commands are exported from a namespace. These - are the ones that can be imported into another namespace. - - namespace import ?-force? ?pattern pattern...? - Makes the specified commands accessible in the current namespace. - - namespace current - Returns the name of the current namespace. - - variable name ?value? ?name ?value?...? - Creates one or more namespace variables. (BTL) - -5/1/97 (bug fix) Under Windows, file times were reported in GMT. Should be -reported in local time. (CCS) - -5/2/97 (feature change) Changed the name of the two Tcl variables used for -tracing bytecode compilation and execution to tcl_traceCompile and -tcl_traceExec respectively. These variables are now documented in the -tclvars man page. (BL) - -5/5/97 (new feature) Support "end" as the index for "lsort -index". (BW) - -5/5/97 (bug fixes) Cleaned up the way the http package resets connections (BW) - -5/8/97 (feature change) Newly created Tcl objects now have a reference count -of zero instead of one. This simplifies C code that stores newly created -objects in Tcl variables or in data structures such as list objects. That C -code must increment the new object's reference count since the variable or -data structure will contain a long-term reference to the object. Formerly, -when new objects started out with reference count one, it was necessary to -decrement the new object's reference count after the store to make sure it -was left with the correct value; this is no longer necessary. (BL) - -5/9/97 (new feature) Added the Tcl_GetsObj interface that takes an -object reference instead of a dynamic string (as in Tcl_Gets). (SS) - -5/12/97 (new feature) Added Tcl_CreateAliasObj and Tcl_GetAliasObj C APIs -to allow an alias command to be created with a vector of Tcl_Obj structures -and to get the vector back later. (JL) - -5/12/97 (feature change) Changed Tcl_ExposeCommand and Tcl_HideCommand to -leave an object result instead of a string result. (JL) - -5/14/97 (feature change) Improved the handling of the interpreter result. -This is still either an object or a string, but the two values are now kept -consistent unless some C code reads or writes interp->result directly. See -the SetResult man page for details. Removed the Tcl_ResetObjResult -procedure. (BL) -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0a2 *** - -5/16/97 (new feature) Added "fcopy" command to move data between -channels. Refer to the manual page for more information. Removed the -"unsupported0" command since it is obsolete now. (SS) - -5/16/97 (new feature) Added Tcl_GetStringResult procedure to allow programs -to get an interpreter's result as a string. If the result was previously set -to an object, this procedure will convert the object to a string. Use of -Tcl_GetStringResult is intended to replace direct access to interp->result, -which is not safe. (BL) - -5/20/97 (new features) Fixed "fcopy" to return the number of bytes -transferred in the blocking case. Updated the http package to use -fcopy instead of unsupported0. Added -timeout and -handler options to -http_get. http_get is now blocking by default. It is only non-blocking -if you supply a -command argument. (BW) - -5/22/97 (bug fix) Fixed several bugs in the "lsort" command having to do -with the -dictionary option and the presence of numbers embedded in the -strings. (JO) - ------------------ Released 8.0b1, 5/27/97 ----------------------- - -6/2/97 (bug fix) Fixed bug in startup code that caused a problem in -finding the library files when they are installed in a directory -containing a space in the name. (SS) - -6/2/97 (bug fix) Fixed bug in Unix notifier where the select mask was -not being cleared under some circumstances. (SS) - -6/4/97 (bug fix) Fixed bug that prevented creation of Tk widgets in -namespaces. Tcl_CreateObjCommand and Tcl_CreateCommand now always create -commands in the global namespace unless the command names are qualified. Tcl -procedures continue to be created in the current namespace by default. (BL) - -6/6/97 (new features) Added new namespace API procedures -Tcl_AppendExportList and Tcl_Export to allow C code to get and set a -namespace's export list. (BL) - -6/11/97 (new feature) Added Tcl_ConcatObj. This object-based routine -parallels the string-based routine Tcl_Concat. (SRP) - -6/11/97 (new feature) Added Tcl_SetObjErrorCode. This object-based -routines parallels the string-based routine Tcl_SetErrorCode. (SRP) - -6/12/97 (bug fix) Fix the "unknown" procedure so that wish under Windows -will exec an external program, instead of always complaining "console1 not -opened for writing". (CCS) - -6/12/97 (bug fix) Fixed core dump experienced by the following simple -script: - interp create x - x alias exec exec - interp delete x -This panic was caused by not installing the new CmdDeleteProc when exec -got redefined by the alias creation step. Reported by Lindsay Marshal (JL) - -6/13/97 (new features) Tcl objects newly created by Tcl_NewObj now have a -string representation that points to a shared heap string of length 1. (They -used to have NULL bytes and typePtr fields. This was treated as a special -case to indicate an empty string, but made type manager implementations -complex and error prone.) The new procedure Tcl_InvalidateStringRep is used -to mark an object's string representation invalid and to free any storage -associated with the old string representation. (BL) -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl7.6 *** - -6/16/97 (bug fix) Tcl_ScanCountedElement could leave braces unmatched -if the string ended with a backslash. (JO) - -6/17/97 (bug fix) Fixed channel event bug where readable events would be -lost during recursive events loops if the input buffers contained -data. (SS) - -6/17/97 (bug fix) Fixed bug in Windows socket code that didn't -reenable read events in the case where an external entity is also -reading from the socket. (SS) - -6/18/97 (bug fix) Changed initial setting of the notifier service mode -to TCL_SERVICE_NONE to avoid unexpected event handling during -initialization. (SS) - -6/19/97 (bug fix/feature change) The command callback to fcopy is now -called in case of errors during the background copy. This adds a second, -optional argument to the callback that is the error string. The callback -in case of errors is required for proper cleanup by the user of fcopy. (BW) -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 *** - -6/19/97 (bug fix) Fixed a panic due to the following four line script: - interp create x - x alias foo bar - x eval rename foo blotz - x alias foo {} -The problem was that the interp code was not using the actual current name -of the command to be deleted as a result of unaliasing foo. (JL) - -6/19/97 (feature change) Pass interp down to the ChannelOption and -driver specific calls so system errors can be differentiated from syntax -ones. Changed Tcl_DriverGetOptionProc type. Affects Tcl_GetChannelOption, -TcpGetOptionProc, TtyGetOptionProc, etc. (DL) -*** POTENTIAL INCOMPATIBILITY *** - -6/19/97 (new feature) Added Tcl_BadChannelOption for use by by driver -specific option procedures (Set and Get) to return a complete and -meaningful error message. (DL) - -6/19/97 (bug fixes) If a system call error occurs while doing an -fconfigure on tcp or tty/com channel: return the appropriate error -message (instead of the syntax error one or none). (Fixed for Unix and -most of the Win and Mac drivers). (DL) - -6/20/97 (feature change) Eval is no longer assumed as the subcommand name -in namespace commands: you must now write "namespace eval nsName {...}". -Abbreviations of namespace subcommand names are now allowed. (BL) -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl7.6 *** - -6/20/97 (feature change) Changed the errorInfo traceback message for -compilation errors from "invoked from within" to "while compiling". (BL) - -6/20/97 (bug fixes) Fixed various compilation-related bugs: - - "UpdateStringOfCmdName should never be called" and - "UpdateStringOfByteCode should never be called" panics. - - Segfault in TclObjInterpProc getting procedure name after evaluation - stack is reallocated (grown). - - Could not use ":" at end of variable and command names. - - Bad code generated for while and for commands with test expressions - enclosed in quotes: e.g., "set i 0; while "$i > 5" {}". - - Command trace procedures would crash if they did a Tcl_EvalObj that - reallocated the evaluation stack. - - Break and continue commands did not reset the interpreter result. - - The Tcl_ExprXXX routines, both string- or object-based, always - modified the interpreter result even if there was no error. - - The argument parsing procedure used by several compile procedures - always treated "]" as end of a command: e.g., "set a ]" would fail. - - Changed errorInfo traceback message for compilation errors from - "invoked from within" to "while compiling". - - Problem initializing Tcl object managers during interpreter creation. - - Added check and error message if formal parameter to a procedure is - an array element. (BL) - -6/23/97 (new feature) Added "registry" package to allow manipulation -of the Windows system registry. See manual entry for details. (SS) - -6/24/97 (feature change) Converted http to a package and added the -http1.0 subdirectory of the Tcl script library. This means you have -to do a "package require http" to use this, as advertised in the man page. (BW) -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 *** - -6/24/97 (bug fix) Ensure that Tcl_Set/GetVar C APIs, when called without -TCL_LEAVE_ERR_MSG, don't touch the interp result. (DL) - -6/26/97 (feature change) Changed name of Tcl_ExprStringObj to -Tcl_ExprObj. (BL) -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b1, but not with Tcl 7.6 *** - ------------------ Released 8.0b2, 6/30/97 ----------------------- - -7/1/97 (new feature) TCL_BUILD_SHARED flag set in tclConfig.sh -when Tcl has been built with --enable-shared. A new tclLibObjs -make target, echoing the list of the .o's needed to build a tcl -library, is now provided. (DL) - -7/1/97 (feature change) compat/getcwd.c removed and changed the -only place where getcwd is used so a new USEGETWD flag selects -the use of the replacement "getwd". Adding this flag is recommended -for SunOS 4 (because getcwd on SunOS 4 uses a pipe to pwd(1)!). (DL) - -7/7/97 (feature change) The split command now supports binary data (i.e., -null characters in strings). (BL) - -7/7/97 (bug fix) string first returned the wrong result if the first -argument string was empty. (BL) - -7/8/97 (bug fix) Fixed core dump in fcopy that could occur when a command -callback was supplied and an error or eof condition caused no background -activity. A refcount bug triggered a panic in Tcl_ListObjAppendElement. (BW) - -7/8/97 (bug fix) Relaxed the pattern matching on http_get so you do not -need a trailing path component. You can now get away with just -http_get www.scriptics.com (BW) - -7/9/97 (bug fix) Creating anonymous interpreters no longer smashes existing -commands with names similar to the generated name. Previously creating an -anonymous interpreter could smash an existing command, now it skips until -it finds a command name that isn't being used. (JL) - -7/9/97 (feature change) Removed the policy management mechanism from the -Safe Base; left the aliases to source and load modules, and to do a limited -form of the "file" command. See entry of 11/15/96. (JL) - -7/9/97 (bug fixes) Fixed various compilation-related bugs: - - Line numbers in errorInfo now are the same as those in Tcl7.6 unless -there are compilation errors. Compilation error messages now include the -entire command in error. - - Trailing ::s after namespace names weren't being ignored. - - Could not refer to an namespace variable with an empty name using a -name of the form "n::". (BL) - -7/9/97 (bug fix) Fixed bug in Tcl_Export that prevented you from exporting -from other than the current namespace. (BL) - -7/9/97 (bug fix) env.test was removing env var needed for proper finding -of libraries in child process. (DL) - -7/10/97 (bug fixes/new feature) Cleanup in Tcl_MakeSafe. Less information -is leaked to safe interps. Error message fixes for interp sub commands. -Likewise changes in safealias.tcl; tcl_safeCreateInterp can now be called -without argument to generate the slave name (like in interp create). (DL) - -7/10/97 (bug fixes) Bytecode compiler now generates more detailed -command location information: subcommands as well as commands now have -location information. This means command trace procedures now get the -correct source string for each command in their command parameter. (BL) - -7/22/97 (bug fixes) Performance improvement in Safe interpreters -handling. Added new mask value to (tclInt.h) Interp.flags record. (DL) - -7/22/97 (bug fix) Fixed panic in 'interp target {} foo'. This bug -was present since Tcl 7.6. (JL) - -7/22/97 (bug fix) Fixed bug in compilation of procedures in namespaces: the -procedure's namespace must be used to look up compile procedures, not the -current namespace. (BL) - -7/22/97 (bug fix) Use of the -channel option of http_get was not setting -the end of line translations mode on the channel, so copying binary data -with the -channel option was corrupting the result on non-unix platforms. (BW) - -7/22/97 (bug fixes) file commands and ~user (seg fault and other -improper returns). (DL) - -7/23/97 (feature change) Reenabled "vwait" in Safe Base. (JL) - -7/23/97 (bug fixes) Fixed two bugs involving read traces on array variables -in procedures: trace procedures were sometimes not called, and reading -nonexistant array elements didn't create undefined element variables that -could later be defined by trace procedures. (BL) - -7/24/97 (bug fix) Windows memory allocation performance was -superlinear in some cases. Made the Mac allocator generic and changed -both the Mac and Windows platforms to use the new allocator instead of -malloc and free. (SS) - -7/24/97 - 8/12/97 (bug fixes/change of features) Completely revamped safe -sourcing/loading (see safe.n) to hide pathnames, use virtual -paths tokens instead, improved security in several respects and made it -more tunable. Multi level interp loading can work too now. Package auto -loading now works in safe interps as long as the package directory is in -the auto_path (no deep crawling allowed in safe interps). (DL) -*** POTENTIAL INCOMPATIBILITY with previous alpha and beta releases *** - -7/24/97 (bug fixes) Made Tcl_SetVar* and Tcl_NewString* treat a NULL value -as an empty string. (This fixes hairy crash case where you would crash -because load command for other interps assumed presence of -errorInfo...). (DL) - -7/28/97 (bug fix) Fixed pkg_mkIndex to understand namespaces. It will -use the export list of a namespace and create auto_index entries for -all export commands. Those names are in their fully qualified form in the -auto_index. Therefore, I tweaked unknown to try both $cmd and ::$cmd. -Also fixed pkg_mkIndex so you can have "package require" commands inside -your packages. These commands are ignored, which is mostly ok except -when you must load another package before loading yours because of -linking dependencies. (BW) - -7/28/97 (bug fix) A variable created by the variable command now persists -until the namespace is destroyed or the variable is unset. This is true even -if the variable has not been initialized; these variables used to be -destroyed if an error occurred when accessing them. In addition, the "info -vars" command lists uninitialized namespace variables, while the "info -exists" command returns 0 for them. (BL) - -7/29/97 (feature change) Changed the http package to use the ::http -namespace. http_get renamed to http::geturl, http_config renamed to -http::config, http_formatQuery renamed to http::formatQuery. -It now provides the 2.0 version of the package. -The 1.0 version is still available with the old names. -*** POTENTIAL INCOMPATIBILITY with Tcl 8.0b2 but not with Tcl 7.6 *** - -7/29/97 (bug fix, new feature) Tcl_Main now uses Tcl objects internally to -preserve NULLs in commands and command output. Added new API procedure -Tcl_RecordAndEvalObj that resembles Tcl_RecordAndEval but takes an object -containing a command. (BL) - -7/30/97 (bug fix) Tcl freed strings in the environ array even if it -did not allocate them. (SS) - -7/30/97 (bug fix) If a procedure is renamed into a different namespace, it -now executes in the context of that namespace. (BL) - -7/30/97 (bug fix) Prevent renaming of commands into and from namespaces as -part of hiding them. (JL) - -7/31/97 (feature change) Moved the history command from C to tcl. -This uses the ::history namespace. The "words" and "substitute" options -are no longer supported. In addition, the "keep" option without a value -returns the current keep limit. There is a new "clear" option. -The unknown command now supports !! again. (BW) -*** POTENTIAL INCOMPATIBILTY *** - -7/30/97 (bug fix) Made sure that a slave can not fool the master into -hiding the wrong command. Made sure we don't crash in hiding + namespaces -issues. (DL) - -8/4/97 (bug fix) Concat, eval, uplevel, and similar commands were -incorrectly trimming trailing space characters from their arguments -even when the space characters were preceded by a backslash. (JO) - -8/4/97 (bug fix) Removed the hard link between bgerror and tkerror. -Only bgerror is supported in tcl core. Tk will still look for a -tkerror but using regular tcl code for that feature. (DL) -*** POTENTIAL INCOMPATIBILTY with code relying on the hard link *** - -8/6/97 (bug fix) Reduced size required for compiled bytecodes by using a -more compact encoding for the command pc-to-source map. (BL) - -8/6/97 (new feature) Added support for additional compilation and execution -statistics when Tcl is compiled with the TCL_COMPILE_STATS flag. (BL) - -8/7/97 (bug fix) Expressions not in {}s that have a comparison operator as -the topmost operator must be compiled out-of-line (call the expr cmd at -runtime) to properly support expr's two-level substitution semantics. An -example is "set a 2; set b {$a}; puts [expr $b == 2]". (BL) - -8/11/97 (bug fix) The catch command would sometimes crash if a variable name -was given and the bytecode evaluation stack was grown when executing the -argument script. (BL) - -8/12/97 (feature change) Reinstated the variable tcl_precision to control -the number of digits used when floating-point values are converted to -strings, with default of 12 digits. However, had to make tcl_precision -shared among all interpreters (except that safe interpreters can't -modify it). This makes the Tcl 8.0 behavior almost identical to 7.6 -except that the default precision is 12 instead of 6. (JO) -*** POTENTIAL INCOMPATIBILITY *** - ------------------ Released 8.0, 8/18/97 ----------------------- - -8/19/97 (bug fix) Minimal fix for glob -nocomplain bugs: -"glob -nocomplain unreadableDir/*" was generating an anonymous -error. More in depth fixes will come with 8.1. (DL). - -8/20/97 (bug fix) Removed check for FLT_MIN in binary command so -underflow conditions are handled by the compiler automatic -conversions. (SS) - -8/20/97 (bug fixes) Fixed several compilation-related bugs: - - Array cmd wasn't detecting arrays that, while compiled, do not yet - exist (e.g., are marked undefined since they haven't been assigned - to yet). - - The GetToken procedure in tclCompExpr.c wasn't recognizing properly - whether an integer token was invalid. For example, "0x$" is not - a valid integer. - - Performance bug in TclExecuteByteCode: the size of its stack frame - was reduced by over 20% by moving errorInfo code elsewhere. - - Uninitialized memory read error in tclCompile.c. (BL) - -8/21/97 (bug fix) safe::interpConfigure now behave like Tk widget's -configure : it changes only the options you provide and you can get -the current value of any single option. New ?-nested boolean? and -?-statics boolean? for all safe::interp* commands but we still -accept (upward compatibility) the previously defined non valued -flags ?-noStatics? and ?-nestedLoadOk?. Improved the documentation. (DL). - -8/22/97 (bug fix) Updated PrintDbl.3 to reflect the fact that the -tcl_precision variable is still used and that it is now shared by all -interpreters. (BL) - -8/25/97 (bug fix) Fixed array access bug in IllegalExprOperandType -procedure in tclExecute.c: it was not properly supporting the || and && -operators. (BL) - -8/27/97 (bug fix) In cases where a channel handler was created with an -empty event mask while data was still buffered in the channel, the -channel code would get stuck spinning on a timer that would starve -idle handlers. This mostly happened in Tk when reading from stdin. (SS) - -9/4/97 (bug fix) Slave interps now inherit the maximum recursion limit -of their parent instead of starting back at the default. {nb: this still -does not prevent stack overflow by multi-interps recursion or aliasing} (DL) - -9/11/97 (bug fix) An uninitialized variable in Tcl_WaitPid caused -pipes to fail to report eof properly under Windows. (SS) - -9/12/97 (bug fix) "exec" was misidentifying some DOS executables as not -executable. (CCS) - -9/14/97 (bug fix) Was using the wrong structure in sizeof operation in -tclUnixChan.c. (JL) - -9/15/97 (bug fix) Fixed notifier to break out of do-one-event loop if -Tcl_WaitForEvent returns 1, so that callers of Tcl_DoOneEvent will get -a chance to check whether the event just handled is significant. This -affected mainly recursive calls to Tcl_VWaitCmd; these did not get a -chance to notice that the variable they were waiting for has been set -and thus they didn't terminate the vwait. (JL, DL, SS) - -9/15/97 (bug fix) Alignment problems in "binary format" would cause a -crash on some platforms when formatting floating point numbers. (SS) - -9/15/97 (bug fix) Fixed bug in Macintosh socket code. Now passes all -tests in socket.test that are not platform specific. (Thanks to Mark -Roseman for the pointer on the fix.) (RJ) - -9/18/97 (bug fix) Fixed bug -dictionary option of lsort that could -cause the compare function to run off the end of an array if the -number only contained 0's. (Thanks to Greg Couch for the report.) (RJ) - -9/18/97 (bug fix) TclFinalizeEnvironment was not cleaning up -properly. (DL, JI) - -9/18/97 (bug fix) Fixed long-standing bug where an "array get" command -did not trigger traces on the array or its elements. (BL) - -9/18/97 (bug fixes) Fixed compilation-related bugs: - - Fixed errorInfo traceback information for toplevel coomands that - contain nested commands. - - In the expr command, && and || now accept boolean operands as well - as numeric ones. (BL) - -9/22/97 (bug fix) Fixed bug that prevented translation modes from being -set independently for input and output on sockets if input was "auto". (JL) - -9/24/97 (bug fix) Tcl_EvalFile(3) and thus source(n) now works fine on -files containing NUL chars. (DL) - -9/26/97 (bug fix) Fixed use of uninitialized memory in the environ array -that later could cause random core dumps. Applies to all platforms. (JL) - -9/26/97 (bug fix) Fixed use of uninitialized memory in socket address data -structure under some circumstances. This could cause random core dumps. -This applies only to Unix. (JL) - -9/26/97 (bug fix) Opening files on PC-NFS volumes would cause a hang -until the system timed after the file was closed. (SS) - -10/6/97 (bug fix) The join(n) command, though objectified, was loosing -NULs in the joinString and in list elements after the 2nd one. -Now you can "join $list \0" for instance. (DL) - -10/9/97 (bug fix) Under windows, if env(TMP) or env(TEMP) referred to a -non-existent directory, exec would fail when trying to create its temporary -files. (CCS) - -10/9/97 (bug fix) Under mac and windows, "info hostname" would crash if -sockets were installed but the hostname could not be determined anyhow. -Tcl_GetHostName() was returning NULL when it should have been returning -an empty string. (CCS) - -10/10/97 (bug fix) "file attribute /" returned error on windows. (CCS) - -10/10/97 (bug fix) Fixed the auto_load procedure to handle procedures -defined in namespaces better. Also fixed pgk_mkIndex so it sees procedures -defined in nested namespaces. Index entries are still only made for -exported procedures. (BW) - -10/13/97 (bug fix) On unix, for files with unknown group or owner -attributes, querying the "file attributes" would return an error rather than -returning the group's or owner's id number, although tha command accepts -numbers when setting the file's group or owner. (CCS) - -10/22/97 (bug fix) "fcopy" did not eval the callback script at the -global scope. (SS) - -10/22/97 (bug fix) Fixed the signature of the CopyDone callback used in -the http package(s) so they can handle error cases properly. (BW) - -10/28/97 (bug fixes) Fixed a problem where lappend would free the Tcl object -in a variable if a Tcl_ObjSetVar2 failed because of an error calling a trace -on the variable. (BL) - -10/28/97 (bug fix) Changed binary scan to properly handle sign -extension of integers on 64-bit or larger machines. (SS) - -11/3/97 (bug fixes) Fixed several bugs: - - expressions such as "expr ($x)" must be compiled out-of-line - (call the expr command procedure at runtime) to ensure the correct - behavior when "$x" is an expression such as "5+10". - - "array set a {}" now creates a new array var with an empty array - value if the var didn't already exist. - - "lreplace $foo end end" no longer returns an error (just an empty - list) if foo is empty. - - upvar will no longer create a variable in a namespace that refers - to a variable in a procedure. - - deleting a command trace within a command trace callback would - make the code that calls traces to reference freed memory. - - significantly sped up "string first" and "string last" (fix from - darrel@gemstone.com). - - seg fault in Tcl_NewStringObj() when a NULL is passed as the byte - pointer argument and Tcl is compiled with -DTCL_MEM_DEBUG. - - documentation and error msg fixes. (BL) - -11/3/97 (bug fix) Fixed a number of I/O bugs related to word sizes on -64-bit machines. (SS) - -11/6/97 (bug fix) The exit code of the first process created by Tcl -on Windows was not properly reported due to an initialization -problem. (SS) - ------------------ Released 8.0p1, 11/7/97 ----------------------- - -11/19/97 (bug fix) Fixed bug in linsert where it sometimes accidently -cleared out a shared argument list object. (BL). - -11/19/97 (bug fix) Autoloading in namespaces was not working properly. -auto_mkindex is still not really namespace aware but most common -cases should now be handled properly (see init.test). (BW, DL) - -11/20/97 (enhancement) Made the changes required by the new Apple -Universal Headers V.3.0, so that Tcl will compile with CW Pro 2. - -11/24/97 (bug fix) Fixed tests in clock test suite that needed the --gmt flag set. Thanks to Jan Nijtmans for reporting the problem. (RJ) - ------------------ Released 8.0p2, 11/25/97 ----------------------- - -12/3/97 (bug fix/optimization) Removed uneeded and potentially dangerous -instances of double evaluations if "if" and "expr" statements from -the library files. It is recommended that unless you need a double -evaluation you always use "expr {...}" instead of "expr ..." and -"if {...} ..." instead of "if ... ...". It will also be faster -thanks to the byte compiler. (DL) - ----- Shipped as part of the plugin2.0b5 as 8.0p2Plugin1, Dec 8th 97 ---- - -12/8/97 (bug fix) Need to protect the newly accepted channel in an -accept callback on a socket, otherwise the callback may close it and -cause an error, which would cause the C code to attempt to close the -now deleted channel. Bumping the refcount assures that the channel sticks -around to be really closed in this case. (JL) - -12/8/97 (bug fix) Need to protect the channel in a fileevent so that it -is not deleted before the fileevent handler returns. (CS, JL) - -12/18/97 (bug fix) In the opt argument parsing package: if the description -had only flags, the "too many arguments" case was not detected. The default -value was not used for the special "args" ending argument. (DL) - -1/15/98 (improvement) Moved common part of initScript in common file. -Moved windows specific initialization to init.tcl so you can initialize -Tcl in windows without having to call Tcl_Init which is now only -searching for init.tcl {back ported from 8.1}. (DL) - ----- Shipped as part of the plugin as 8.0p2Plugin2, Jan 15th 98 ---- - -5/27/98 (bug fix) Windows socket driver did not notice new data arriving -on nonblocking sockets until the event loop was entered. (SS) - -5/27/98 (bug fix) Windows socket driver used FIONREAD, which is not -supported correctly by WinSock. (SS) - -6/9/98 (bug fix) Generic channel code failed to report readable file -events on buffered data that was left behind by a gets or read that -did not consume all available data. (SS) - -6/18/98 (bug fix) Compilation of loop expressions was too aggressive -and incorrectly inlined non-literal expressions. (SS) - -6/18/98 (bug fix) "info var" and "info locals" incorrectly reported -the existence of compiler temporary variables. (SS) - -6/18/98 (bug fix) Dictionary sorting used signed character -comparisons. (SS) - -6/18/98 (bug fix) Compile procs corrupted the exception stack in some -cases. (SS) - -6/18/98 (bug fix) Array set had erratic behavior when initializing a -variable from an empty value list. (SS) - -6/18/98 (bug fix) The Windows registry package had a bad bounds check -that could lead to a crash. (SS) - -6/18/98 (bug fix) The foreach compile proc did not correctly handle -non-local variable references. (SS) - -6/25/98 (new features) Added name resolution hooks to support [incr Tcl]. -There are new internal Tcl_*Resolver* APIs to add, query and remove the hooks. -With this changes it should be possible to dynamically load [incr Tcl] -as an extension. (MM) - -7/1/97 (bug fix) The commands "info args, body, default, procs" did -not correctly handle imported procedures. (RJ) - -7/6/98 (improvement) pkg_mkIndex now implements the "package require" -command. This makes it possible to create index files for packages -that require another package and then execute code from that package in -their file. Previously, this would throw an error because the required -package had not been loaded. The -nopkgrequied flag is provided to -revert back to the old functionality. (EMS) - -7/6/98 (improvement) back-ported the -direct flag from 8.1 into -pkg_mkIndex. This results in pkgIndex.tcl files that contain direct -source or load commands instead of tclPkgSetup commands. (EMS) - -7/6/98 (improvement) made changes to the AuxData items structures to support -storage of compiled scripts on disk. Also some related minor changes in -the compilation and execution engine. (EMS) - -6/4/98 (enhancement) Added new internal routines to support inserting -and deleting from the stat, access, and open-file-channel mechanisms. -TclAccessInsertProc, TclStatInsertProc, & TclOpenFileChannelInsertProc -insert pointers to such routines; TclAccessDeleteProc, TclStatDeleteProc, -& TclOpenFileChannelDeleteProc delete pointers to such routines. See -the file generic/tclIOUtils.c for more details. (SKS) - -7/1/98 (enhancement) Added a new internal C variable -tclPreInitScript. This is a pointer to a string that may hold an -initialization script; If this pointer is non-NULL it is evaluated in -Tcl_Init() prior to the built-in initialization script defined in the -file generic/tclInitScript.h. (SKS) - -7/6/98 (bug fix) Removed dead code in PlatformInitExitHandler so that -the TCL_LIBRARY value can be safely patched in binaries. (BW) - -7/24/98 (enhancement) Incorporated a new version of auto_mkindex that -can support the [incr Tcl] class structures. This version will index -all procedures in a source file, not just those where "proc" starts -at the beginning of the line. If you want the old behavior, use the -auto_mkindex_old procedure. (MM) - -7/24/98 (feature change) Changed the Windows registry key to be -HKEY_LOCAL_MACHINE\Software\Scriptics\Tcl\8.0, and to store the path -in the default value instead of "Root". Also, this key can be -specified at compile time in case Tcl is being used in a different -context where it needs an alternate library path from the standard Tcl -installation. (SS) - -7/24/98 (feature change) Changed the search order for init.tcl. The -tcl_library variable can now be set before calling Tcl_Init to avoid -doing any searches. If it isn't set, then Tcl checks -env(TCL_LIBRARY), the static value set at compile time, an install -directory relative to the executable, a source directory relative to -the executable, and a tcl directory relative to the source heirarchy -containing the executable. See the comment at the top of -generic/tclInitScript.h for more details. (SS) - -7/27/98 (config change) Changed the use of the DBGX flag in configure.in -and the makefile to be TCL_DBGX. Users of tclConfig.sh may need to pass -this through their configure files with AC_SUBST. (BW) - -729/98 (bug fix) Changed [info body] to return a copy of the body of a -compiled procedure instead of the body itself, to avoid invalidation -of the internal rep and loss of the byte-codes. (EMS) - -8/5/98 (bug fix) The platform init code could walk off the end of a -buffer when reading the PkgPath registry value on Windows. (SS) - -8/5/98 (Windows makefile change) Introduced a set of macros to deal with -exporting symbols when compiling DLLS on Windows. See win/README for -details. (EMS) - -8/5/98 (addendum) Added a second Windows registry key under -HKEY_LOCAL_MACHINE\Software\Scriptics\Tcl\8.0, named "pkgPath". -This is a multi-string value used to initialize the tcl_pkgPath -variable. This is required if extension DLLs are in architecture specific -subdirectories. (SS) - -8/6/98 (new feature) Added tcl_findLibrary to init.tcl for use by -extensions, including Tk. This searches in a canonical way for -an extensions library directory and initialization file. (BW) - -8/10/98 (bug fix) Imported commands used to get lost if the target -of the import was redefined. Tcl_CreateCommand and Tcl_CreateObjCommand -were updated to restore import links. (Note that if you rename a command, -the import links move to the new name, and if you delete a command then -the import links get lost. These semantics have not changed.) (MC) - --------- Released 8.0.3 to the Tcl Consortium CD-ROM project, 8/10/98 ------ - -9/3/98 (bug fix) Tcl_Realloc was failing under Windows because the -GlobalReAlloc API was not correctly re-allocating blocks that were -32k+. The fix was to use newer Win32 APIs (HeapAlloc, HeapFree, and -HeapReAlloc.) (BS) - -10/5/98 (bug fix) Fixed bug in pkg_mkIndex that caused some files that do -a "package require" of packages in the Tcl libraries to give a warning like - warning: "xx.tcl" provides more than one package ({xx 2.0} {yy 0.3}) -and generate a broken pkgIndex.tcl file. (EMS) - -10/5/98 (bug fix) Pkg_mkIndex was not doing a case-insensitive comparison -of extensions to determine whether to load or source a file. Thus, under -Windows, MYDLLNAME.DLL was sourced, and mydllname.dll loaded. (EMS) - -10/5/98 (new feature) Created a new Tcl_Obj type, "procbody". This object's -internal representation holds a pointer to a Proc structure. Extended -TclCreateProc to take both strings and "procbody". (EMS) - -10/13/98 (bug fix) The "info complete" command can now handle strings -with NULLs embedded. Thanks to colin@field.medicine.adelaide.edu.au -for providing this fix. (RJ) - -10/13/98 (bug fix) The "lsort -dictionary" command did not properly -handle some numbers starting with 0. Thanks to Richard Hipp - for submitting the fix to Scriptics. (RJ) - -10/13/98 (bug fix) The function Tcl_SetListObj was creating an invalid -Tcl_Obj if the list had zero elements (despite what the comments said -it would do). Thanks to Sebastian Wangnick for reporting the -problem. (RJ) - -10/20/98 (new feature) Added tcl_platform(debug) element to the -tcl_platform array on Windows platform. The existence of the debug -element of the tcl_platform array indicates that the particular Tcl -shell has been compiled with debug information. Using -"info exists tcl_platform(debug)" a Tcl script can direct the -interpreter to load debug versions of DLLs with the load -command. (SKS) - -10/20/98 (feature change) The Makefile and configure scripts have been -changed for IRIX to build n32 binaries instead of the old 32 abi -format. If you have extensions built with the o32 abi's you will need -to update them to n32 for them to work with Tcl. (RJ) -*** POTENTIAL INCOMPATIBILITY *** - -10/23/98 (bug fix) tcl_findLibrary had a stray ] in one of the -pathnames it searched for the initialization script. tclInitScript.h -was incorrectly adding the parent of tcl_library to tcl_pkgPath. This -logic was moved into init.tcl, and the initialization of auto_path was -documented. Thanks to Donald Porter and Tom Silva for related -patches. (BW) - -10/29/98 (bug fix) Fixed Tcl_NotifyChannel to use Tcl_Preserve instead -of Tcl_RegisterChannel so that 1) unregistered channels do not get -closed after their first fileevent, and 2) errors that occur during -close in a fileevent script are actually reflected by the close -command. (BW) - -10/30/98 (bug fix) Overhaul of pkg_mkIndex to deal with transitive -package requires and packages split among scripts and binary files. -Also fixed ommision of global for errorInfo in tcl_findLibrary. (BW) - -11/08/98 (bug fix) Fixed the resource command to always detect -the case where a file is opened a second time with the same -permissions. IM claims that this will always cause the same -FileRef to be returned, but in MacOS 8.1+, this is no longer the case, -so we have to test for this explicitly. (JI) - -11/10/98 (feature change) When compiling with Metrowerk's MSL, use the -exit function from MSL rather than ExitToShell. This allows MSL to -clean up its temporary files. Thanks to Vince Darley for this -improvement. (JI) - ------------------ Released 8.0.4, 11/19/98 ------------------------- - -11/20/98 (bug fix) Handle possible NULL return in TclGetStdFiles. (RJ) - -11/20/98 (bug fix) The dltests would not build on SGI. They reported -that you could not mix n32 with 032 binaries. The configure script -has been modified to get the EXTRA_CFLAGS from the tcl configure -script. [Bug id: 840] (RJ) - -12/3/98 (bug fix) Windows NT creates sockets so they are inheritable -by default. Fixed socket code so it turns off this bit right after -creation so sockets aren't kept open by exec'ed processes. [Bug: 892] -Thanks to Kevin Kenny for this fix. (SS) - -1/11/98 (bug fix) On HP, "info sharedlibextension" was returning -empty string on static apps. It now always returns ".sl". (RJ) - -1/28/99 (configure change) Now support -pipe option on gcc. (RJ) - -2/2/99 (bug fix) Fixed initialization problem on Windows where no -searching for init.tcl would be performed if the registry keys were -missing. (stanton) - -2/2/99 (bug fix) Added support for HKEY_PERFORMANCE_DATA and -HKEY_DYN_DATA keys in the "registry" command. (stanton) - -2/2/99 (bug fix) ENOTSUP and EOPNOTSUPP clashed on some Linux -variants. (stanton) - -2/2/99 (enhancement) The "open" command has been changed to use the -object interfaces. (stanton) - -2/2/99 (bug fix) In some cases Tcl would crash due to an overflow of -the exception stack resulting from a missing byte code in some -expressions. (stanton) - -2/2/99 (bug fix) Changed configure so Linux and IRIX shared libraries -are linked with the system libraries. (stanton) - -2/2/99 (bug fix) Added support for BSDI 4.x (BSD/OS-4*) to the -configure script. (stanton) - -2/2/99 (bug fix) Fixed bug where upvar could resurrect a namespace -variable after the namespace had been deleted. (stanton) - -2/2/99 (bug fix) In some cases when creating variables, the -interpreter result was being modified even if the TCL_LEAVE_ERR_MSG -flag was set. (stanton) - -2/2/99 (bug fix & new feature) Changed the socket drivers to properly -handle failures during an async socket connection. Added a new -fconfigure option "-error" to retrieve the failure message. See the -socket.n manual entry for details. (stanton) - -2/2/99 (bug fix) Deleting a renamed interp alias could result in a -panic. (stanton) - -2/2/99 (feature change/bug fix) Changed the behavior of "file -extension" so that it splits at the last period. Now the extension of -a file like "foo..o" is ".o" instead of "..o" as in previous versions. -*** POTENTIAL INCOMPATIBILITY *** - ------------------ Released 8.0.5, 3/9/99 ------------------------- - -======== Changes for 8.0 go above this line ======== -======== Changes for 8.1 go below this line ======== - -6/18/97 (new feature) Tcl now supports international character sets: - - All C APIs now accept UTF-8 strings instead of iso8859-1 strings, - wherever you see "char *", unless explicitly noted otherwise. - - All Tcl strings represented in UTF-8, which is a convenient - multi-byte encoding of Unicode. Variable names, procedure names, - and all other values in Tcl may include arbitrary Unicode characters. - For example, the Tcl command "string length" returns how many - Unicode characters are in the argument string. - - For Java compatibility, embedded null bytes in C strings are - represented as \xC080 in UTF-8 strings, but the null byte at the end - of a UTF-8 string remains \0. Thus Tcl strings once again do not - contain null bytes, except for termination bytes. - - For Java compatibility, "\uXXXX" is used in Tcl to enter a Unicode - character. "\u0000" through "\uffff" are acceptable Unicode - characters. - - "\xXX" is used to enter a small Unicode character (between 0 and 255) - in Tcl. - - Tcl automatically translates between UTF-8 and the normal encoding for - the platform during interactions with the system. - - The fconfigure command now supports a -encoding option for specifying - the encoding of an open file or socket. Tcl will automatically - translate between the specified encoding and UTF-8 during I/O. - See the directory library/encoding to find out what encodings are - supported (eventually there will be an "encoding" command that - makes this information more accessible). - - There are several new C APIs that support UTF-8 and various encodings. - See Utf.3 for procedures that translate between Unicode and UTF-8 - and manipulate UTF-8 strings. See Encoding.3 for procedures that - create new encodings and translate between encodings. See - ToUpper.3 for procedures that perform case conversions on UTF-8 - strings. - -9/18/97 (enhancement) Literal objects are now shared by the ByteCode -structures created when compiled different scripts. This saves up to 45% -of the total memory needed for all literals. (BL) - -9/24/97 (bug fixes) Fixed Tcl_ParseCommand parsing of backslash-newline -sequences at start of command words. Suppressed Tcl_EvalDirect error logging -if non-TCL_OK result wasn't an error. (BL) - -10/17/97 (feature enhancement) "~username" now refers to the users' home -directory on Windows (previously always returned failure). (CCS) - -10/20/97 (implementation change) The Tcl parser has been completely rewritten -to make it more modular. It can now be used to parse a script without actually -executing it. The APIs for the new parser are not correctly exported, but -they will eventually be exported and augmented with Tcl commands so that -Tcl scripts can parse other Tcl scripts. (JO) - -10/21/97 (API change) Added "flags" argument to Tcl_EvalObj, removed -Tcl_GlobalEvalObj procedure. Added new procedures Tcl_Eval2 and -Tcl_EvalObjv. (JO) -*** POTENTIAL INCOMPATIBILITY *** - -10/22/97 (API change) Renamed Tcl_ObjSetVar2 and Tcl_ObjGetVar2 to -Tcl_SetObjVar2 and Tcl_GetObjVar2 (for consistency with other C APIs) -and changed the name arguments to be strings instead of objects. (JO) -*** POTENTIAL INCOMPATIBILITY *** - -10/27/97 (enhancement) Bytecode compiler rewritten to use the new Tcl -parser. (BL) - -11/3/97 (New routines) Added Tcl_AppendObjToObj, which appends the -string rep of one Tcl_Obj to another. Added Tcl_GetIndexFromObjStruct, -which is similar to Tcl_GetIndexFromObj, except that you can give an -offset between strings. This allows Tcl_GetIndexFromObjStruct to be -called with a table of records which have strings in them. (SRP) - -12/4/97 (enhancement) New Tcl expression parser added. Added new procedure -Tcl_ParseExpr and new token types TCL_TOKEN_SUB_EXPR and -TCL_TOKEN_OPERATOR. Expression compiler is reimplemented to use this -parser. (BL) - -12/9/97 (bug fix) Tcl_EvalObj() increments/decrements the refcount of the -script object to prevent the object from deleting itself while in the -middle of being evaluated. (CCS) - -12/9/97 (bug fix) Memory leak in Tcl_GetsObjCmd(). (CCS) - -12/11/97 (bug fix) Environment array leaked memory when compiled with -Visual C++. (SS) - -12/11/97 (bug fix) File events and non-blocking I/O did not work on -pipes under Windows. Changed to use threads to achieve non-blocking -behavior. (SS) - -12/18/97 (bug fixes) Fixed segfault in "namespace import"; importing a -procedure that causes a cycle now returns an error. Modified "info procs", -"info args", "info body", and "info default" to return information about -imported procedures as well as procedures defined in a namespace. (BL) - -12/19/97 (enhancement) Added new Tcl_GetString() procedure that can be used -in place of Tcl_GetStringFromObj() if the string representation's length -isn't needed. (BL) - -12/18/97 (bug fix) In the opt argument parsing package: if the description -had only flags, the "too many arguments" case was not detected. The default -value was not used for the special "args" ending argument. (DL) - -1/7/98 (clean up) Moved everything not absolutly necessary out of init.tcl -procs now in auto.tcl and package.tcl can be autoloaded if needed. (DL) - -1/7/98 (enhancement) tcltest made at install time will search for it's -init.tcl where it is, even when using virtual path compilation. (DL) - -1/8/98 (os bug workaround) when needed, using a replacement for memcmp so -string compare "char with high bit set" "char w/o high bit set" returns -the expected value on all platforms. (DL) - -1/8/98 (unix portability/configure) building from .../unix/targetName/ -subdirectories and simply using "../configure" should now work fine. (DL) - -1/14/98 (enhancement) Added new regular expression package that -supports AREs, EREs, and BREs. The new package includes new escape -characters, meta-syntax, and character classes inside brackets. -Regexps involving backslashes may behave differently. (MH) -*** POTENTIAL INCOMPATIBILITY *** - -1/16/98 (os workaround) Under windows, "file volume" was causing chatter -and/or several seconds of hanging when querying empty floppy drives. -Changed implementation to call an empirically-derived function that doesn't -cause this. (CCS) - -1/16/98 (enhancement) Converted regular expressions to a Tcl_Obj type so -their compiled form gets cached automatically. Reduced NSUBEXP from 100 -to 20. (BW) - -1/16/98 (documentation) Change unclear documentation and comments for -functions like Tcl_TranslateFileName() and Tcl_ExternalToUtfDString(). Now -it explicitly says they take an uninitialized or free DString. A DString -that is "empty" or "not holding anything" could have been interpreted as one -currently with a zero length, but with a large dynamically allocated buffer. -(CCS) - ------------------ Released 8.1a1, 1/22/98 ----------------------- - -1/28/98 (new feature) Added a "-direct" optional flag to pkg_mkIndex -to generate direct loading package indexes (such those you need -if you use namespaces and plan on using namespace import just after -package require). pkg_mkIndex still has limitations regarding -package dependencies but errors are now ignored and with -direct, correct -package indexes can be generated even if there are dependencies as long -as the "package provide" are done early enough in the files. (DL) - -1/28/98 (enhancement) Performance tuning of regexp and regsub. (CCS) - -1/28/98 (bug fix) regexp and regsub with "-indices" returned the byte-offsets -of the characters in the UTF-8 representation, not the character offsets -themselves. (CCS) - -1/28/98 (bug fix) "clock format 0 -format %Z -gmt 1" would return the local -timezone string instead of "GMT" on Solaris and Windows. - -1/28/98 (bug fix) Restore tty settings when closing serial device on Unix. -This is good behavior when closing real serial devices, essential when -closing the pseudo-device /dev/tty because the user's terminal settings -would be left useless, in raw mode, when tcl quit. (CCS) - -1/28/98 (bug fix) Tcl_OpenCommandChannel() was modifying the contents of the -argv array passed to it, causing problems for any caller that wanted to -continue to use the argv array after calling Tcl_OpenCommandChannel(). (CCS) - -2/1/98 (bug fix) More bugs with %Z in format string argument to strftime(): -1. Borland always returned empty string. -2. MSVC always returned the timezone string for the current time, not the - timezone string for the specified time. -3. With MSVC, "clock format 0 -format %Z -gmt 1" would return "GMT" the first - time it was called, but would return the current timezone string on all - subsequent calls. (CCS) - -2/1/98 (bug fix) "file stat" was broken on Windows. -1. "file stat" of a root directory (local or network) or a relative path that - resolved to a root directory (c:. when in pwd was c:/) was returning error. -2. "file stat" on a regular file (S_IFREG), the st_mode was sign extended to - a negative int if the platform-dependant type "mode_t" was declared as a - short instead of an unsigned short. -3. "file stat" of a network directory, the st_dev was incorrectly reported - as the id of the last accessed local drive rather than the id of the - network drive. (CCS) - -2/1/98 (bug fix) "file attributes" of a relative path that resolved to a -root directory was returning error. (CCS) - -2/1/98 (bug fix) Change error message when "file attribute" could not -determine the attributes for a file. Previously it would return different -error messages on Unix vs. Windows vs. Mac. (CCS) - -2/4/98 (bug fixes) Fixed several instances of bugs where the parser/compiler -would reach outside the range of allocated memory. Improved the array -lookup algorithm in set compilation. (DL) - -2/5/98 (change) The TCL_PARSE_PART1 flag for Set/Get(Obj)Var2 C APIs is now -deprecated and ignored. The part1 is always parsed when the part2 argument -is NULL. This is to avoid a pattern of errors for extension writers converting -from string based Tcl_SetVar() to new Tcl_SetObjVar2() and who could easily -forget to provide the flag and thus get code working for normal variables -but not for array elements. The performance hit is minimal. A side effect -of that change is that is is no longer possible to create scalar variables -that can't be accessed by tcl scripts because of their invalid name -(ending with parenthesis). Likewise it is also parsed and checked to -ensure that you don't create array elements of array whose name is a valid -array element because they would not be accessible from scripts anyway. -Note: There is still duplicate array elements parsing code. (DL) -*** POTENTIAL INCOMPATIBILITY *** - -2/11/98 (bug fix) Sharing objects between interps, such as by "interp -eval" or "send" could cause a crash later when dereferencing an interp -that had been deleted, given code such as: - set a {set x y} - interp create foo - interp eval foo $a - interp delete foo - unset a -Interp "foo" was gone, but "a" had a internal rep consisting of bytecodes -containing a dangling pointer to "foo". Unsetting "a" would attempt to -return resources back to "foo", causing a crash as random memory was -accessed. The lesson is that that if an object's internal rep depends on -an interp (or any other data structure) it must preserve that data in -some fashion. (CCS) - -2/11/98 (enhancement) The "interp" command was returning inconsistent error -messages when the specified slave interp could not be found. (CCS) - -2/11/98 (bug fix) Result codes like TCL_BREAK and TCL_CONTINUE were not -propagating through the master/slave interp boundaries, such as "interp -eval" and "interp alias". TCL_OK, TCL_ERROR, and non-standard codes like -teh integer 57 work. There is still a question as to whether TCL_RETURN -can/should propagate. (CCS) - -2/11/98 (bug fix) TclCompileScript() was derefering memory 1 byte before -start of the string to compile, looking for ']'. (CCS,DL) - -2/11/98 (bug fix) Tcl_Eval2() was derefering memory 1 byte before start -of the string to eval, looking for ']'. (CCS,DL) - -2/11/98 (bug fix) Compiling "set a(b" was running off end of string. (CCS,DL) - -2/11/98 (bug fix) Windows initialization code was dereferencing -uninitialized memory if TCL_LIBRARY environment didn't exist. (CCS) - -2/11/98 (bug fix) Windows "registry" command was dereferencing -uninitialized memory when constructing the $errorCode for a failed -registry call. (CCS) - -2/11/98 (enhancement) Eliminate the TCL_USE_TIMEZONE_VAR definition from -configure.in, because it was the same information as the already existing -HAVE_TM_ZONE definition. The lack of HAVE_TM_ZONE is used to work around a -Solaris and Windows bug where "clock format [clock sec] -format %Z -gmt 1" -produces the local timezone string instead of "GMT". (CCS) - -2/11/98 (bug fix) Memleaks and dereferencing of uninitialized memory in -regexp if an error occurred while compiling a regular expression. (CCS). - -2/18/98 (new feature) Added mutexes and thread local storage in order -to make Tcl thread safe. For testing purposes, there is a testthread -command that creates a new thread and an interpreter inside it. See -thread.test for examples, but this script-level interface is not fixed. -Each thread has its own notifier instance to manage its own events, -and threads can post messages to each other's message queue. -This uses pthreads on UNIX, and native thread support on other platforms. -You enable this by configuring with --enable-threads. Note that at -this time *Tk* is still not thread safe. Special thanks to -Richard Hipp: his earlier implementation inspired this work. (BW, SS, JI) - -2/18/98 (hidden feature change) The way the env() array is shared among -interpreters changed. Updates to env used to trigger write traces in -other interpreters. This undocumented feature is no longer implemented. -Instead, variable tracing is used to keep the C-level environ array in sync -with the Tcl-level env array. This required adding TCL_TRACE_ARRAY support -to Tcl_TraceVar2 so that array names works properly. (BW) -*** POTENTIAL INCOMPATIBILITY *** - -2/18/98 (enhancement) Conditional compilation for unix systems (e.g., -IRIX, SCO) that use f_bsize instead of st_blksize to determine disk block -size. (CCS) - -2/23/98 (bug fix) Fixed the emulation of polling selects in the threaded -version of the Unix notifier. The bug was showing up on a multiprocessor -as starvation of the notifier thread. (BW) - ------------------ Released 8.1a2, Feb 23 1998 ----------------------- - -9/22/98 (bug fix) Changed the value of TCL_TRACE_ARRAY so it no longer -conflicts with the deprecated TCL_PARSE_PART1 flag. This should -improve portability of C code. (stanton) - -10/6/98 (bug fix) The compile procedure for "if" incorrectly attempted -to match against the literal string "if", resulting in a stack -overflow when "::if" was compiled. It also would incorrectly accept -"if" instead of "elsif" in later clauses. (stanton) - -10/15/98 (new feature) Added a "totitle" subcommand to the "string" -command to convert strings to capitalize the first character of a string -and lowercase all of the other characters. (stanton) - -10/15/98 (bug fix) Changed regexp and string commands to properly -handle case folding according to the Unicode character -tables. (stanton) - -10/21/98 (new feature) Added an "encoding" command to facilitate -translations of strings between different character encodings. See -the encoding.n manual entry for more details. (stanton) - -11/3/98 (bug fix) The regular expression character classification -syntax now includes Unicode characters in the supported -classes. (stanton) - -11/6/98 (bug fix) Variable traces were causing crashes when upvar -variables went out of scope. [Bug: 796] (stanton) - -11/9/98 (bug fix) "format" now correctly handles multibyte characters -in %s format strings. (stanton) - -11/10/98 (new feature) "regexp" now accepts three new switches -("-line", "-lineanchor", and "-linestop") that control how regular -expressions treat line breaks. See the regexp manual entry for more -details. (stanton) - -11/17/98 (bug fix) "scan" now correctly handles Unicode -characters. (stanton) - -11/17/98 (new feature) "scan" now supports XPG3 position specifiers -and the "%n" conversion character. See the "scan" manual entry for -more details. (stanton) - -11/17/98 (bug fix) The Tcl memory allocator now returns 8-byte aligned -chunks of memory which improves performance on Windows and avoids -crashes on other platforms. [Bug: 834] (stanton) - -11/23/98 (bug fix) Applied various regular expression performance bug -fixes supplied by Henry Spencer. (stanton) - -11/30/98 (bug fix) Fixed various thread related race conditions. [Bug: -880 & 607] (stanton) - -11/30/98 (bug fix) Fixed a number of memory overflow and leak -bugs. [Bug: 584] (stanton) - -12/1/98 (new feaure) Added support for Korean encodings. (stanton) - -12/1/98 (feature change) Changed the Tcl_EvalObjv interface to remove -the string and length arguments. -*** POTENTIAL INCOMPATIBILITY with previous alpha releases *** - -12/2/98 (bug fix) Fixed various bugs related to line feed -translation. [Bug: 887] (stanton) - -12/4/98 (new feature) Added a message catalog facility to help with -localizing Tcl scripts. Thanks to Mark Harrison for contributing the -initial implementation of the "msgcat" package. (stanton) - -12/7/98 (bug fix) The memory allocator was failing to update the -block list for large memory blocks that were reallocated into a -different address. [Bug: 933] (stanton) - ------------------ Released 8.1b1, Dec 10 1998 ----------------------- - -12/22/98 (performance improvement) Improved the -command option of the -lsort command to better use the object system for improved -performance (about 5x speed up). Thanks to Syd Polk for suppling the -patch. [RFE: 726] (rjohnson) - -2/10/99 (bug fix) Restored the Tcl_ObjSetVar2/Tcl_ObjGetVar2 -interfaces from 8.0 and renamed the Tcl_GetObjVar2/Tcl_SetObjVar2 -interfaces to Tcl_GetVar2Ex and Tcl_SetVar2Ex. This should provide -better compatibility with 8.0. (stanton) -*** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases *** - -2/10/99 (bug fix) Made the eval interfaces compatible with 8.0 by -renaming Tcl_EvalObj to Tcl_EvalObjEx, renaming Tcl_Eval2 to -Tcl_EvalEx and restoring Tcl_EvalObj and Tcl_GlobalEvalObj interfaces -so they match Tcl 8.0. (stanton) -*** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases *** - -2/25/99 (bug fix/new feature) On Windows, the channel drivers for -consoles and serial ports now completely support file events. (redman) - -3/5/99 (bug fix) Integrated patches to fix various configure problems -that affected HP-UX-11, 64-bit IRIX, Linux, and Solaris. (stanton) - -3/9/99 (bug fix) Integrated various AIX related patches to improve -support for shared libraries. (stanton) - -3/9/99 (new feature) Added tcl_platform(user) to provide a portable -way to get the name of the current user. (welch) - -3/9/99 (new feature) Integrated the stub library mechanism contributed -by Jan Nijtmans, Paul Duffin, and Jean-Claude Wippler. This feature -should make it possible to write extensions that support multiple -versions of Tcl simultaneously. It also makes it possible to -dynamically load extensions into statically linked interpreters. This -patch includes the following changes: - - Added a Tcl_InitStubs() interface - - Added Tcl_PkgProvideEx, Tcl_PkgRequireEx, Tcl_PkgPresentEx, - and Tcl_PkgPresent. - - Added va_list versions of all VARARGS functions so they can be - invoked from wrapper functions. -See the manual for more information. (stanton) - - -3/10/99 (feature change) Replaced Tcl_AlertNotifier with -Tcl_ThreadAlert since the Tcl_AlertNotifier function relied on passing -internal data structures. (stanton) -*** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases *** - -3/10/99 (new feature) Added a Tcl_GetVersion API to make it easier to -check the Tcl version and patch level from C. (redman) - -3/14/99 (feature change) Tried to unify the TclpInitLibrary path -routines to look in similar places from Windows to UNIX. The new -library search path is: TCL_LIBRARY, TCL_LIBRARY/../tcl8.1, relative -to DLL (Windows Only) relative to installed executable, relative to -develop executable, and relative to compiled-in in location (UNIX -Only.) This fix included: - - Defining a TclpFindExecutable - - Moving Tcl_FindExecutable to a common area in tclEncoding.c - - Modifying the TclpInitLibraryPath routines. -(surles) - -3/14/99 (feature change) Added hooks for TclPro Wrapper to initialize -the location of the encoding files and libraries. This fix included: - - Adding the TclSetPerInitScript routine. - - Modifying the Tcl_Init routines to evaluate the non-NULL - preinit script. - - Adding the Tcl_SetdefaultEncodingDir and Tcl_GetDefaultEncodingDir - routines. - - Modifying the TclpInitLibrary routines to append the default - encoding dir. -(surles) - -3/14/99 (feature change) Test suite now uses "test" namespace to -define the test procedure and other auxiliary procedures as well as -global variables. - - Global array testConfige is now called ::test::testConfig. - - Global variable VERBOSE is now called ::test::verbose, and - ::test::verbose no longer works with numerical values. We've - switched to a bitwise character string. You can set - ::test::verbose by using the -verbose option on the Tcl command - line. - - Global variable TESTS is now called ::test::matchingTests, and - can be set on the Tcl command line via the -match option. - - There is now a ::test::skipTests variable (works similarly to - ::test::matchTests) that can be set on the Tcl command line via - the -match option. - - The test suite can now be run in any working directory. When - you run "make test", the working directory is nolonger switched - to ../tests. -(hirschl) -*** POTENTIAL INCOMPATIBILITY *** - ---------------- Released 8.1b2, March 16, 1999 ---------------------- - -3/18/99 (bug fix) Fixed missing/incorrect characters in shift-jis table -(stanton) - -3/18/99 (feature change) The glob command ignores the -FS_CASE_IS_PRESERVED bit on file systesm and always returns -exactly what it gets from the system. (stanton) -*** POTENTIAL INCOMPATIBILITY *** - -3/19/99 (new feature) Added support for --enable-64bit. For now, -this is only supported on Solaris 7 64bit (SunOS 5.7) using the Sun -compiler. (redman) - -3/23/99 (bug fix) Fixed fileevents and gets on Windows consoles and -serial devices so that non-blocking channels do not block on partial -input lines. (redman) - -3/23/99 (bug fix) Added a new Tcl_ServiceModeHook interface. -This is used on Windows to avoid the various problems that people -have been seeing where the system hangs when tclsh is running -outside of the event loop. As part of this, renamed -TclpAlertNotifier back to Tcl_AlertNotifier since it is public. -(stanton) - -3/23/99 (feature change) Test suite now uses "tcltest" namespace to -define the test procedure and other auxiliary procedures as well as -global variables. The previously chosen "test" namespace was thought -to be too generic and likely to create conflits. -(hirschl) -*** POTENTIAL INCOMPATIBILITY *** - -3/24/99 (bug fix) Make sockets thread safe on Windows. -(redman) - -3/24/99 (bug fix) Fix cases where expr would incorrect return -a floating point value instead of an integer. (stanton) - -3/25/99 (bug fix) Added ASCII to big5 and gb2312 encodings. -(stanton) - -3/25/99 (feature change) Changed so aliases are invoked at current -scope in the target interpreter instead of at the global scope. This -was an incompatibility introduced in 8.1 that is being removed. -(stanton) -*** POTENTIAL INCOMPATIBILITY with previous beta releases *** - -3/26/99 (feature change) --enable-shared is now the default and build -Tcl as a shared library; specify --disable-shared to build a static Tcl -library and shell. -*** POTENTIAL INCOMPATIBILITY *** - -3/29/99 (bug fix) Removed the stub functions and changed the stub -macros to just use the name without params. Pass &tclStubs into the -interp (don't use tclStubsPtr because of collisions with the stubs on -Solaris). (redman) - -3/30/99 (bug fix) Loadable modules are now unloaded at the last -possible moment during Tcl_Finalize to fix various exit-time crashes. -(welch) - -3/30/99 (bug fix) Tcl no longer calls setlocale(). It looks at -env(LANG) and env(LC_TYPE) instead. (stanton) - -4/1/99 (bug fix) Fixed the Ultrix multiple symbol definition problem. -Now, even Tcl includes a copy of the Tcl stub library. (redman) - -4/1/99 (bug fix) Internationalized the registry package. - -4/1/99 (bug fix) Changed the implemenation of Tcl_ConditionWait and -Tcl_ConditionNotify on Windows. The new algorithm eliminates a race -condition and was suggested by Jim Davidson. (welch) - -4/2/99 (new apis) Made various Unicode utility functions public. -Tcl_UtfToUniCharDString, Tcl_UniCharToUtfDString, Tcl_UniCharLen, -Tcl_UniCharNcmp, Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, -Tcl_UniCharIsDigit, Tcl_UniCharIsLower, Tcl_UniCharIsSpace, -Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar, Tcl_WinUtfToTChar, -Tcl_WinTCharToUtf (stanton) - -4/2/99 (feature change) Add new DDE package and removed the Tk -send command from the Windows version. Changed DDE-based send -code into "dde eval" command. The DDE package can be loaded -into tclsh, not just wish. Windows only. (redman) - -4/5/99 (bug fix) Changed safe-tcl so that the encoding command -is an alias that masks out the "encoding system" subcommand. -(redman) - -4/5/99 (bug fix) Configure patches to improve support for -OS/390 and BSD/OS 4.*. (stanton) - -4/5/99 (bug fix) Fixed crash in the clock command that occurred -with negative time values in timezones east of GMT. (stanton) - -4/6/99 (bug fix) Moved the "array set" C level code into a common -routine (TclArraySet). The TclSetupEnv routine now uses this API to -create an env array w/ no elements. This fixes the bug caused when -every environ varaible is removed, and the Tcl env variable is -synched. If no environ vars existed, the Tcl env var would never be -created. (surles) - -4/6/99 (bug fix) Made the Env module I18N compliant. (surles) - -4/6/99 (bug fix) Changed the FindVariable routine to TclpFindVariable, -that now does a case insensitive string comparison on Windows, and not -on UNIX. (surles) - ---------------- Released 8.1b3, April 6, 1999 ---------------------- - -4/9/99 (bug fix) Fixed notifier deadlock situation when the pipe used -to talk back notifier thread is filled with data. Found as a result of the -focus.test for Tk hanging. (redman) - -4/13/99 (bug fix) Fixed bug where socket -async combined with -fileevent for writing did not work under Windows NT. (redman) - -4/13/99 (encoding fix) Restored the double byte definition of GB2312 -and added the EUC-CN encoding. EUC-CN is a variant of GB2312 that -shifts the characters into bytes with the high bit set and includes -ASCII as a subset. (stanton) - -4/27/99 (bug fix) Added 'extern "C" {}' block around the stub table -pointer declaration so the stub library can be used from C++. (stanton) - ---------------- Released 8.1 final, April 29, 1999 ---------------------- - -4/22/99 (bug fix) Changed Windows NT socket implementation to avoid -creating a communication window. This avoids the problem where the -system hangs waiting for tclsh to respond to a system-wide synchronous -broadcast (e.g. if you change system colors). (redman) - -4/22/99 (bug fix) Added call to TclWinInit from TclpInitPlatform when -building a static library since DllMain will not be invoked. This -could break old code that explicitly called TclWinInit, but should be -simpler in the long run. (stanton) -*** POTENTIAL INCOMPATIBILITY *** - -4/23/99 (bug fix) Added support for the koi8-r Cyrillic -encoding. [Bug: 1771] (stanton) - -4/28/99 (bug fix) Changed internal Tcl_Obj usage to avoid freeing the -internal representation after the string representation has been -freed. This makes it easier to debug extensions. (stanton) - -4/30/99 (bug fix) Fixed a memory leak in CommandComplete. (stanton) - -5/3/99 (bug fix) Fixed a bug where the Tcl_ObjType was not being set -in a duplicated Tcl_Obj. [Bug: 1975, 2047] (stanton) - -5/3/99 (bug fix) Changed Tcl_ParseCommand to avoid modifying eval'ed -strings that are already null terminated. [Bug: 1793] (stanton) - -5/3/99 (new feature) Applied Jeff Hobbs's string patch which includes -the following changes: - - added new subcommands: equal, repeat, map, is, replace - - added -length option to "string compare|equal" - - added -nocase option to "string compare|equal|match" - - string and list indices can be an integer or end?-integer?. - - added optional first and last index args to string toupper, et al. -See the string.n manual entry for more details about the new string -features. [Bug: 1845] (stanton) - -5/6/99 (new feature) Added Tcl_UtfNcmp and Tcl_UtfNcasecmp to make Utf -string comparision easier. (stanton) - -5/7/99 (bug fix) Improved OS/390 support. [Bug: 1976, 1997] (stanton) - -5/12/99 (bug fix) Changed Windows initialization code to avoid using -GetUserName system call in favor of the env(USERNAME) variable. This -provides a significant startup speed improvement. (stanton) - -5/12/99 (bug fix) Replaced the per-interpreter regexp cache with a -per-thread cache. Changed the Regexp object to take advantage of this -extra cache. Added a reference count to the TclRegexp type so regexps -can be shared by multiple objects. Removed the per-interp regexp cache -from the interpreter. Now regexps can be used with no need for an -interpreter. This set of changes should provide significant speed -improvements for many Tcl scripts. [Bug: 1063] (stanton) - -5/14/99 (bug fix) Durining initialization on Unix, Tcl now extracts the -encoding subfield from the LANG/LC_ALL environment variables in cases -where the locale is not found in the built-in locale table. It also -attempts to initialize the locale subsystem so X11 is happy. [Bug: 1989] -(stanton) - -5/14/99 (bug fix) Applied the patch to fix 100-year and 400-year -boundaries in leap year code, from Isaac Hollander. [Bug: 2066] (redman) - -5/14/99 (bug fix) Fixed a crash caused by a failure to reset the result -before evaluating the test expression in an uncompiled for -statement. (stanton) - -5/18/99 (bug fix) Modified initialization code on Windows to avoid -inherenting closed or invalid channels. If the standard input is -anything other than a console, file, serial port, or pipe, then we fall -back to the standard Tk window console. (stanton) - -5/19/99 (bug fix) Added an extern "C" block around the entire tcl.h -header file to avoid C++ linkage issues. (redman) - -5/19/99 (new feature) Applied Jeff Hobb's patch to add -Tcl_StringCaseMatch to support case insensitive glob style matching and -Tcl_UniCharIs* character classification functions. (stanton) - -5/20/99 (bug fix) Added the directory containing the executuble and the -../lib directory relative to that to the auto_path variable. (redman) - ---------------- Released 8.1.1, May 25, 1999 ---------------------- - -5/21/99 (bug fix) Fixed launching command.com on Win95/98, no longer -hangs. [Bug: 2105] (redman) - -5/28/99 (bug fix) Fixed bug where dde calls were being passed an -invalid dde handle. [Bug: 2124] (stanton) - -6/1/99 (bug fix) Small configure.in patches. [Bug: 2121] (stanton) - -6/1/99 (bug fix) Applied latest regular expression patches to fix an -infinite loop bug and add support for testing whether a string could -match with additional input. [Bug: 2117] (stanton) - -6/2/99 (bug fix) Fixed incorrect computation of relative ordering in -Utf case-insensitive comparison. [Bug: 2135] (stanton) - -6/3/99 (bug fix) Fxied bug where string equal/compare -nocase -reported wrong result on null strings. [Bug: 2138] (stanton) - -6/4/99 (new feature) Windows build now uses Cygwin tools plus GNU -make and autoconf to build static/dynamic and debug/nodebug. (stanton) - -6/7/99 (new feature) Optimized string index, length, range, and -append commands. Added a new Unicode object type. (hershey) - -6/8/99 (bug fix) Rolled back Windows socket driver to 8.1.0 -version. (stanton) - -6/9/99 (new feature) Added Tcl_RegExpMatchObj and Tcl_RegExpGetInfo -to public Tcl API, these functions are needed by Expect. Changed -tools/genStubs.tcl to always write output in LF mode. (stanton) - -6/14/99 (new feature) Merged string and Unicode object types. Added -new public Tcl API functions: Tcl_NewUnicodeObj, Tcl_SetUnicodeObj, -Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, -Tcl_AppendUnicodeToObj. (hershey) - -6/16/99 (new feature) Changed to conform to TEA specification, added -tcl.m4 and aclocal.m4 macro libraries for configure. (wart) - -6/17/99 (new feature) Added new regexp interfaces: -expanded, -line, --linestop, and -lineanchor switches. Renamed Tcl_RegExpMatchObj to -Tcl_RegExpExecObj and added new Tcl_RegExpMatchObj that is equivalent -to Tcl_RegExpMatch. Added public macros for regexp flags. Added -REG_BOSONLY flag to allow Expect to iterate through a string and only -find matches that start at the current position within the -string. (stanton) - -6/21/99 (bug fix) Fixed memory leak in TclpThreadCreate where thread -attributes were not being released. [Bug: 2254] (stanton) - -6/23/99 (new feature) Updated Unicode character tables to reflect -Unicode 2.1 data. (stanton) - -6/25/99 (new feature) Fixed bugs in non-greedy quantifiers for regular -expression code. (stanton) - -6/25/99 (new feature) Added initial implementation of new Tcl test -harness package. Modified test files to use new tcltest package. -(jenn) - -6/26/99 (new feature) Applied patch from Peter Hardie to add poke -command to dde and changed the dde package version number to -1.1. (redman) - -6/28/99 (bug fix) Applied patch from Peter Hardie to fix problem in -Tcl_GetIndexFromObj() when the key being passed is the empty string. -[Bug: 1738] (redman) - -6/29/99 (new feature) Added options to tcltest package: -preservecore, --limitconstraints, -help, -file, -notfile, and flags. (jenn) - -7/3/99 (new feature) Changed parsing of variable names to allow empty -array names. Now "$(foo)" is a variable reference. Previously you -had to use something line $::(foo), which is slower. This change was -requested by Jean-Luc Fontaine for his STOOOP package. (welch) - -7/3/99 (new feature) Added Tcl_SetNotifier (public API) and -associated hook points in the notifiers to be able to replace the -notifier calls at runtime. The Xt notifier and test program use this -hook. (welch) - -7/3/99 (new feature) Added a new variant of the "Trf core patch" from -Andreas Kupries that adds new C APIs Tcl_StackChannel, -Tcl_UnstackChannel, and Tcl_GetStackedChannel. This allows the Trf -extension to work without applying patches to the Tcl core. (welch) - -7/6/99 (new feature) Added -timeout option to http.tcl to handle -timeouts that occur during connection attempts to hosts that are -down. (welch) - -7/6/99 (bug fix) Applied new implementation of the Windows serial -port driver from Rolf Schroedter that fixes reading only one byte from -the port at a time. Uses polling every 10ms to implement -fileevents. [Bug: 1980 2217] (redman) - -7/8/99 (bug fix) Applied fix for bug in DFA state caching under -lookahead conditions (regular expressions). [Bug: 2318] (stanton) - -7/8/99 (bug fix) Fixed bug in string range bounds checking -code. (stanton) - ---------------- Released 8.2b1, July 14, 1999 ---------------------- - -7/16/99 (bug fix) Added Tcl_SetNotifier to stub table. [Bug: 2364] -Added check for Alpha/Linux to correct the IEEE floating point flag, -patch from Don Porter. (redman) - -7/20/99 (bug fix) Merged 8.0.5 code to handle tcl_library properly, -also fixed a bug that caused TCL_LIBRARY to be ignored. (hershey) - -7/21/99 (bug fix) Implemented modified socket driver for Windows that -uses a thread to manage the socket event window. Code works the same -on all supported versions of Windows and was based on original 8.1.0 -code. [Bug: 2178 2256 2259 2329 2323 2355] (redman) - -7/21/99 (new feature) Applied patch from Rolf Schroedter to add --pollinterval option to fconfigure for Windows serial ports. Allows -the maxblocktime to be modified to control how often serial ports are -checked for fileevents. Also added documentation for \\.\comX -notation for opening serial ports on Windows. (redman) - -7/21/99 (bug fix) Changed APIs in stub tables to use "unsigned long" -instead of the platform-specific "size_t", primarily after SunOS 4 -users could no longer compile. (redman) - -7/22/99 (bug fix) Fixed crashing during "array set a(b) {}". -[Bug: 2427] (redman) - -7/22/99 (bug fix) The install-sh script must be given execute -permissions prior to running. [Bug: 2413] (redman) - -7/22/99 (bug fix) Applied patch from Ulrich Ring to remove ANSI-style -prototypes in the code. [Bug: 2391] (redman) - -7/22/99 (bug fix) Added #if blocks around #includes of sys/*.h header -files, to allow an extension author on Windows to use the MetroWerks -compiler. [Bug: 2385] (redman) - -7/22/99 (bug fix) Fixed running the safe.test test suite, one change -to the Windows Makefile.in to fix paths and another in safe.test to -check for the tcl_platform(threaded) variable properly. (redman) - -7/22/99 (bug fix) Fixed hanging in new Win32 socket driver with -threads enabled. (redman) - -7/26/99 (bug fix) Fixed terminating of helper threads by holding any -mutexes from the primary thread while waiting for the helper thread to -terminate. Fixes dual-CPU WinNT hangs, only one rare sporadic hang -that still exists with dual-CPU WinNT. Also fixed test cases so that -they would not depend as much on timing for dual-CPU WinNT. (redman) - -7/27/99 (bug fix) Some test suite cleanup. (jenn) - -7/29/99 (bug fix) Applied patch to fix typo in .SH NAME line in -doc/Encoding.n [Bug: 2451]. Applied patch to avoid linking pack.n to -pack-old.n [Bug: 2469]. Patches from Don Porter. (redman) - -7/29/99 (bug fix) Allow tcl to open CON and NUL, even for redirection -of std channels. [Bug: 2393 2392 2209 2458] (redman) - -7/30/99 (bug fix) Applied fixed Trf patch from Andreas Kupries. -[Bug: 2386] (hobbs) - -7/30/99 (bug fix) Fixed bug in info complete. [Bug: 2383 2466] (hobbs) - -7/30/99 (bug fix) Applied patch to fix threading on Irix 6.5, patch -provided by James Dennett. [Bug: 2450] (redman) - -7/30/99 (bug fix) Fixed launching of 16bit applications on Win9x from -wish. The command line was being primed with tclpip82.dll, but it was -ignored later. - -7/30/99 (bug fix) Added functions to stub table, patch provided by Jan -Nijtmans. [Bug: 2445] (hobbs) - -8/1/99 (bug fix) Changed Windows socket driver to terminate threads -by sending a message to the window rather than calling -TerminateThread(), which seems to leak about 4k from the helper -thread's stack space. (redman) - ---------------- Released 8.2b2, August 5, 1999 ---------------------- - -8/4/99 (bug fix) Applied patches supplied by Henry Spencer to greatly -enhance performance of certain classes of regular expressions. -[Bug: 2440 2447] (stanton) - -8/5/99 (doc change) Made it clear that tcl_pkgPath was not set for -Windows. [Bug: 2455] (hobbs) - -8/5/99 (bug fix) Fixed reference to bytes that might not be null -terminated in tclLiteral.c. [Bug: 2496] (hobbs) - -8/5/99 (bug fix) Fixed typo in http.tcl. [Bug: 2502] (hobbs) - -8/9/99 (bug fix) Fixed test suite to handle larger integers -(64bit). Patch from Don Porter. (hobbs) - -8/9/99 (documentation fix) Clarified Tcl_DecrRefCount docs -[Bug: 1952]. Clarified array pattern docs [Bug: 1330]. Fixed clock docs -[Bug: 693]. Fixed formatting errors [Bug: 2188 2189]. Fixed doc error -in tclvars.n [Bug: 2042]. (hobbs) - -8/9/99 (bug fix) Fixed path handling in auto_execok [Bug: 1276] (hobbs) - -8/9/99 (internal api change) Removed the TclpMutexLock and TclpMutexUnlock -APIs and added a new exported api, Tcl_GetAllocMutex. These APIs are all for -the mutex used in the simple memory allocators. By making this change -we are able to substitute different implementations of the thread-related -APIs without having to recompile the Tcl core. (welch) - -8/9/99 (new C API) Tcl_GetChannelNames returns a list of open channel -names in the interpreter result. Still no Tcl-level version of this, -but server-like applications can use this to clean up files without -deleting interpreters. (welch) - -8/9/99 (bug fix) Traces were not firing on "info exists", which used to -happen in Tcl 7.6 and earlier. An "info exists" now fires a read trace, -if defined. This makes it possible to fully implement variables that -are defined via traces. (welch) - -8/10/99 (bug fix) Fixed Brent's changes so that they work on -Windows. (redman) - ---------------- Released 8.2b3, August 11, 1999 ---------------------- - -8/12/99 (Mac) Rearrange projects in tclMacProjects.sea.hqx so that the -build directory is separate from the sources. (Jim Ingham) - -8/12/99 (bug fix) Fixed bug in Tcl_EvalEx where the termOffset was not -being updated in cases where the evaluation returned a non TCL_OK -error code. [Bug: 2535] (stanton) - ---------------- Released 8.2.0, August 17, 1999 ---------------------- - -9/21/99 (config fixes) fixed several AIX configuration issues. gcc and -threading may still cause problems on AIX. (hobbs) - -9/21/99 (bug fix) fixed expr double-eval problem. [Bug: 732] (hobbs) - -9/21/99 (bug fix) fixed static buffer overflow problem. [Bug: 2483] (hobbs) - -9/21/99 (bug fix) fixed end-int linsert interpretation. [Bug: 2693] (hobbs) - -9/21/99 (bug fix) fixed bug when setting array in non-existent -namespace. [Bug: 2613] (hobbs) - ---- Released 8.2.1, October 04, 1999 - -10/30/99 (feature enhancement) new regexp engine from Henry Spencer -was patched in - should greatly reduce stack space usage. (spencer) - -10/30/99 (bug fix) fixed Purify reported memory leaks in findexecutable -test command, TclpCreateProcess on Unix, in handling of C environ array, -and in testthread code. No more known (reported) mem leaks for Tcl -built using gcc on Solaris 2.5.1. Also none reported for Tcl on NT -(using Purify 6.0). (hobbs) - -10/30/99 (bug fix) fixed improper bytecode handling of -'eval {set array($unknownvar) 5}' (also for incr) (hobbs) - -10/30/99 (bug fix) fixed event/io threading problems by making -triggerPipe non-blocking (nick kisserbeth) - -10/30/99 (bug fix) fixed Tcl_AppendStringsToObjVA and Tcl_AppendResultVA -to only iterates once over the va_list (avoiding non-portable memcpy). -(joe english, hobbs) - -10/30/99 (bug fix) removed savedChar trick in tclCompile.c that appeared -to be causing a segv when the literal table was released. -[Bug: 2459, 2515] (David Whitehouse) - -10/30/99 (bug fix) fixed [string index] to return ByteArrayObj -when indexing into one (test case string-5.16) [Bug: 2871] (hobbs) - -10/30/99 (bug fix) fixes for mac UTF filename handling (ingham) - ---- Released 8.2.2, November 04, 1999 - -11/19/99 (feature enhancement) bug fixes for http package as well as -patch required by TLS (SSL) extension that adds http::(un)register -and -type to http::geturl. Up'd http pkg version to 2.2. - -11/19/99 (bug fix) removed extra decr of numLevels in Tcl_EvalObjEx -that could cause seg fault (mjansen@wendt.de) - -11/19/99 (bug fixes) numerous minor big fixes, including correcting the -installation of the koi8-r encoding and tcltest1.0 on Windows. - -11/30/99 (bug fix) fixes scan where %[..] didn't match anything - -11/30/99 (bug fix) fixed setting of isNonBlocking flag in PipeBlockModeProc -so you can now close a non-blocking channel without waiting. - -11/30/99 (bug work-around) prevented the unloading of DLLs for Unix in -TclFinalizeLoad. This stops the seg fault on exit that some users would -see (ie with oratcl) when using DLLs that do nasty things like register -atexit handlers. - -12/07/99 (bug fix) fixes for 'expr + {[incr]}' and 'expr + {[error]}' -cases (different causes). - ---- Released 8.2.3, December 16, 1999 - -1999-09-14 (feature enhancement) added -start switch to regexp and regsub. - -1999-09-15 (feature enhancement) add 'array unset' command. - -1999-09-15 (feature enhancement) rewrote runtime libraries to use new -string functions - -1999-08-18 (feature enhancement) added 'file channels' command, along with -Tcl_GetChannelNames(Ex) public C APIs. - -1999-10-19 (feature enhancement) enhanced tcltest package - -1999-09-16 (feature enhancement) added -milliseconds switch to 'clock clicks' - -1999-10-28 (feature enhancement) added support for inline 'scan' - -1999-10-28 (feature enhancement) added support for touch functionality by -extendeding 'file atime' and 'file mtime' to take an optional time argument - -1999-11-24 (feature enhancement) added 'fconfigure $sock -lasterror' -command to Windows to query the last error received on a serial socket. - -1999-11-30 (bug fix) fixed handling of %Z on NT for timezones that don't -have DST - -1999-12-03 (feature enhancement) improved error message in bad octal cases -and improper use of comments. (hobbs) - -1999-12-07 (bug fix) fixed Tcl_ScanCountedElement to not step -beyond the end of the counted string - -1999-12-09 (feature enhancement) removed all references to 16 bit -compatibility code for Windows (hobbs) - -1999-12-10 (bug fix) removed check for vfork - Tcl now uses only fork in -exec. (hobbs) - -1999-12-10 (optimization) changed Tcl_ConcatObj to return a list -object when it receives all pure list objects as input (used by 'concat'), -added optimizations in Tcl_EvalObjEx for pure list case, and optimized -INST_TRY_CVT_TO_NUMERIC in TclExecuteByteCode for boolean objects. -(oakley, hobbs) - -1999-12-12 (feature enhancement) enhanced glob command with -type, -path, --directory and -join switches. (darley, hobbs) - -1999-12-21 (bug fix) changed CreateThread to _beginthreadex and -ExitThread to _endthreadex to prevent 4K mem leak (gravereaux) - -1999-12-21 (bug fix) fixed applescript for I18N - -1999-12-21 (feature enhancement) added -unique option to lsort (hobbs) - -1999-12-21 (bug fix) changed thread ids to longs (for 64bit systems) - ---- Released 8.3b1, December 22, 1999 - -2000-01-10 (feature enhancement) clock scan now supports the common -ISO 8601 date/time formats. See docs for details. (melski) - -2000-01-10 (bug fix) prevented \ooo substitution from accepting -non-octal digits [Bug: 3975] (hobbs) - -2000-01-11 (bug fix) fixed improper handling of DST by clock when -using relative times (like "1 month" or "tomorrow"). (melski) - -2000-01-12 (bug fix) improved build support for Tru64 v5, NetBSD -and Reliant Unix (hobbs) - -2000-01-12 (bug fix) made imported commands also import their -compile procedure (duffin) - -2000-01-12 (bug fix) fixed 'info procs ::namesp::*' behavior to return -procs in a namespace (dejong) - -2000-01-12 (feature enhancement) added support for setting permissions -symbolicly (like chmod) in [file attributes $file -permissions ...] (schoebel) - -2000-01-13 (bug fix) fixed lsort -dictionary problem when sorting -characters between 'Z' and 'a' (flawed upper/lower comparison logic) (melski) - ---- Released 8.3b2, January 13, 2000 - -2000-01-14 (feature enhancement) clock format %Q added, clock scan updated - -2000-01-20 (bug fix) corrected complex array elem compiling (Spjuth) - -2000-01-20 (bug fix) made [info body] always return a string type arg, -to prevent possible misuse of bytecodes in the wrong context (hobbs) - -2000-01-20 (bug fixes) several fixes to variable handling to prevent -possible crashes, and further definition of correct behavior (melski) - -2000-01-25 (bug fixes) improved QNX, Ultrix and OSF1 (Tru64) config and -compatibility (edge, furukawa) - -2000-01-25 (bug fix) fixed mem leak when calling lsort with a bad -command -argument (hobbs) - -2000-01-27 (feature enhancement) package mechanism overhaul: changed -behavior of pkg_mkIndex to do -direct by default, added -lazy option. -Fixed pkg_mkIndex to handle odd proc names and auto_mkIndex to use platform -independent file paths. Other fixes for odd package quirks. Added -::pkg namespace and ::pkg::create helper function. (melski) - -2000-02-01 (bug fix) fixed problem where http POST would send one extra -newline (vasiljevic) - -2000-02-02 (feature enhancement) added docs for new regexp -inline and --all switches. (hobbs) - -2000-02-08 (bug fix) corrected handling of "next monthname" in clock scan -(melski) - -2000-02-09 (bug fix) restored Mac source to build readiness and prevented -mac panic from an error when closing an async socket (steffen, ingham) - -2000-02-10 (feature enhancement) improved error reporting for failed -loads on Windows (dejong, hobbs) - ---- Released 8.3.0, February 10, 2000 - -2000-03 (bug fixes, feature enhancement) overhaul of http package for -proper handling of async callbacks (new options), version is now at 2.3 -(tamhankar, welch) - -2000-03 (performance enhancement) speedup in Windows filename handling (newman) -and ==/!= empty string in exprs. (hobbs) - -2000-03-27 (bug fix) added uniq'ing test to namespace export list to -prevent unnecessary mem growth (hobbs) - -2000-03-29 (bug fix) fixed mem leak when repeatedly sourcing the same -bytecompiled (tbc) code repeatedly across different interpreters (hobbs) - -2000-03-29 (config enhancement) improved build support for gcc/mingw on -Windows (nijtmans, hobbs) and added RPM target (melski) - -2000-03-31 (bug fix) corrected data encoding problem when using -"exec << $data" construct (melski) - -2000-04 (feature enhancement) overhaul of threading mechanism to better -support tcl level thread command (new APIs Tcl_ConditionFinalize, -Tcl_MutexFinalize, Tcl_CreateThread, etc, all docs in Thread.3). -(kupries, graveraux) -This enables the tcl level thread extension. (welch) - -2000-04-10 (bug fix) fixed infinite loop case in regexp -all (melski) - -2000-04-13 (config enhancement) added support for --enable-64bit-vis -Sparc target. (hobbs) - -2000-04-18 (bug fix) moved tclLibraryPath to thread-local storage to fix -possible race condition on MP machines (hobbs) - -2000-04-18 (config enhancement) added MacOS X build target and -tclLoadDyld.c dl type. (sanchez) - -2000-04-23 (bug fix) several Mac socket fixes (ingham) - -2000-04-24 (bug fix) fixed hang in threaded Unix case when backgrounded -exec process was running (dejong) - ---- Released 8.3.1, April 26, 2000 - -2000-04-26 (doc fix) updated/added documentation for many API's and -commands (melski) - -2000-05-02 (feature enhancement) added support for joinable threads; -extended API's for channels to allow channels to move between threads -(kupries) - -2000-05-02 (feature enhancement) changed error return for procedures -with incorrect args to be like the Tcl_WrongNumArgs API, with a "wrong -# args: ..." message printed, with an args list (hobbs) - -2000-05-08 (feature enhancement) added [array statistics] command - -2000-05-08 (performance enhancement) rewrote Tcl_StringCaseMatch -algorithm for better performance; this affects the [string match] -command; added "eq" and "ne" operands to expr, for testing -string equality and inequality (hobbs) - -2000-05-09 (feature enhancement) extended [lsearch] to support sorted -list searches and typed list searches (melski) - -2000-05-10 (feature enhancement) added [namespace exists] command -(darley) - -2000-05-18 (build enhancement) added support for mingw compile env and -cross-compiling (dejong) - -2000-05-18 (bug fix) corrected clock grammar to properly handle the -"ago" keyword when it follows multiple relative unit specifiers -(melski) - -2000-05-22 (compile fix) type cast cleanups (dejong) - -2000-05-23 (performance enhancement) added byte-compiled -implementation of [return] command and [string] command (melski) - -2000-05-26 (performance enhancement) extended byte-compiled [string] -command with support for [string compare/index/match] (hobbs) - -2000-05-27 (feature enhancement) added ability to set [info script] -return value ([info script ?newFileName?]) (welch) - -2000-05-31 (feature enhancement) added support for regexp and exact -pattern matching for [array names] (gazetta) - -2000-05-31 (feature enhancement) added -nocomplain and -- flags to -[unset] to allow for silent unset operation (hobbs) - ---- Released 8.4a1, June 6, 2000 - -2000-05-29 (bug fix) corrected resource cleanup in http error cases. -Improved handling of error cases in http. (tamhankar) - -2000-07 (feature rewrite) complete rewrite of the Tcl IO channel subsystem -to correct problems (hangs, core dumps) with the initial stacked channel -implementation. The new system has many more tests for robustness and -scalability. There are new C APIs (see Tcl_CreateChannel), but only -stacked channel drivers are affected (ie: TLS, Trf, iogt). The iogt -extension has been added to the core test code to test the system. -(hobbs, kupries) - **** POTENTIAL INCOMPATABILITY **** - -2000-07 (build improvements) cleanup of the makefiles and configure scripts -to correct support for building under gcc for Windows. (dejong) - -2000-08-07 (bug fix) corrected sizeof error in Tcl_GetIndexFromObjStruct. -(perkins) - -2000-08-07 (bug fix) correct off-by-one error in HistIndex, which was -causing [history redo] to start its search at the wrong event index. (melski) - -2000-08-07 (bug fix) corrected setlocale calls for XIM support and locale -issues in startup. (takahashi) - -2000-08-07 (bug fix) correct code to handle locale specific return values -from strftime, if any. (wagner) - -2000-08-07 (bug fix) tweaked grammar to properly handle the "ago" keyword -when it follows multiple relative unit specifiers, as in -"2 days 2 hours ago". (melski) - -2000-08-07 (doc fixes) numerous doc fixes to correct SEE ALSO and NAME -sections. (english) - -2000-08-07 (bug fix) new man pages memory.n, TCL_MEM_DEBUG.3, Init.3 and -DumpActiveMemory.3. (melski) - ---- Released 8.3.2, August 9, 2000 - -2000-06 thru 2000-11 (build improvements) Added support for mingw (gcc on -Windows), AIX-5 and Win64 builds (dejong, hobbs) - -2000-06-23 (feature enhancement) ability to use Tcl_Obj *s as hash keys (duffin) - -2000-06-29 (new features) added [mcmax] and [mcmset] and extended [unknown] in -msgcat package (duperval, krone, nelson) -=> msgcat 1.1 - -2000-08 thru 2000-09 added tclPlatDecls.h to default install (melski, hobbs) - -2000-08-24 (new feature) Enhanced trace syntax to add: - trace {add|remove|list} {variable|command} name ops command -(darley, melski) - -2000-09-06 (cross-platform feature) Set ^Z (\x1A) as default EOF char. (hobbs) - -2000-09-07 partial fix for bug 2460 to prevent exec mem leak on Windows for the -common case (gravereaux) - -2000-09-14 Improved string allocation growth for large strings (hintermayer, -melski) - -2000-09-14 New non-panic'ing mem allocation functions Tcl_AttemptAlloc, -Tcl_AttemptRealloc, Tcl_AttemptSetObjLength (melski) - -2000-09-20 (new features) completely new, enhanced syntax in tcltest package. -Backwards compatable with tcltest v1. (hom) -=> tcltest 2.0 - -2000-09-27 (bug fix) fixed a bug introduced by a partial fix in 8.3.2 that -didn't set nonBlocking correctly when resetting the flags for the write -side (mem leak) Correct mem leak in channels when statePtr was released -(hobbs) - -2000-09-29 (bug fix) corrected reporting of space parity on Windows (Eason) - -2000-10-06 (bug fix) corrected [file channels] to only return channels in -the current interpreter (hobbs) - -2000-10-20 (performance enhancement) call stat only when necessary in 'glob' to -speed up command significantly in base cases (hobbs) - -2000-10-27 Fixed mem leak in Tcl_CreateChannel. Re-purified core via test -suites. (hobbs) - -2000-10-30 (new feature) add "ja_JP.eucJP" map to "euc-jp" encoding (takahashi) - -2000-11-01 (mem leak) Corrected excessive mem use of info exists on a -non-existent array element (hobbs) - -2000-11-02 (bug fix) Corrected sharing of tclLibraryPath in threaded -environment (gravereaux) - -2000-11-03 (new feature) Tcl_SetMainLoop enables defining an event loop for -tclsh. This enables Tk as a truly loadable package. (hobbs) - ---- Released 8.4a2, November 3, 2000 - -2000-09-27 (bug fix) fixed a bug introduced by a partial fix in 8.3.2 that -didn't set nonBlocking correctly when resetting the flags for the write -side (mem leak) Correct mem leak in channels when statePtr was released -(hobbs) - -2000-09-29 (bug fix) corrected reporting of space parity on Windows (Eason) - -2000-10-06 (bug fix) corrected [file channels] to only return channels in -the current interpreter (hobbs) - -2000-10-20 (performance enhancement) call stat only when necessary in 'glob' to -speed up command significantly in base cases (hobbs) - -2000-11-01 (mem leak) Corrected excessive mem use of info exists on a -non-existent array element (hobbs) - -2000-11-02 (bug fix) Corrected sharing of tclLibraryPath in threaded -environment (gravereaux) - -2000-11-23 (mem leak) fixed potential memory leak in error case of lsort -(fellows) - -2000-12-09 (feature enhancement) changed %o and %x to use strtoul instead -of strtol to correctly preserve scan<>format conversion of large integers -(hobbs) -Fixed handling of {!} in expressions (hobbs, fellows) - -2000-12-14 (feature enhancement) improved (s)rand for 64-bit platforms -(porter) - -2001-01-04 (bug fix) corrected parsing of $tcl_libPath at startup on -Windows (porter) - -2001-01-30 (bug fix) Fixed possible hangs in fcopy. (porter) - -2001-02-15 (performance enhancement) improved efficiency of [string split] -(fellows) - -2001-03-13 (bug fix) Correctly possible memory corruption in string map {} -$str (fellows) - -2001-03-29 (bug fix) prevent potential race condition and security leak in -tmp filename creation on Unix. (max) -Fixed handling of timeout for threads (corrects excessive CPU usage issue -for Tk on Unix in threaded Tcl environment). (ruppert) - -2001-03-30 (bug fix) corrected Windows memory error on exit (wu) -Fixed race condition in readability of socket on Windows. - -2001-04-03 (doc fixes) numerous doc corrections and clarifications. -Update of READMEs. - -2001-04-04 (build improvements) redid Mac build structure (steffen) -Corrected IRIX-5* configure (english). Added support for AIX-5 (hobbs). -Added support for Win64 (hobbs). - ---- Released 8.3.3, April 6, 2001 - -2000-11-23 (new feature)[TIP 7] higher resolution timer on Windows (kenny) - -2001-01-18 (new feature) Tcl_InitHashTableEx renamed to Tcl_InitCustomHashTable -(kupries) - -2001-03-30 (new feature)[TIP 10] support for thread-aware/hot channels (kupries) - -2001-04-06 (new feature)[219280] auto-loading hidden in ::errorInfo (porter) - -2001-04-07 (bug fix)[406709] corrected panic when extra items left on the -byte compiler execution stack (sofer) - -2001-04-09 (bug fix)[219136,232558] improved use of thread-safe functions in -unix time commands (kenny) - -2001-04-24 (new feature)[TIP 27] started CONST-ification of the Tcl APIs (kenny) - -2001-05-03 (new feature) [auto_import] now matches patterns like -[namespace import], not like [string match] (porter) - **** POTENTIAL INCOMPATABILITY **** - -2001-05-07 (new feature)[416643] distinct srand() seed per interp (sofer) - -2001-05-15 (new feature) new Tcl_GetUnicodeFromObj API (hobbs) - -2001-05-16 (performance enhancement) byte-compiled versions of [lappend], -[append] simple cases (hobbs) - -2001-05-23 (new feature) added ISO-8859-15 and koi8-u encodings, updated other -encoding tables based on http://www.unicode.org/Public/MAPPINGS/ (kuhn) - -2001-05-27 (new feature) updated to Unicode 3.1.0 data set (still using 16 -bits for Tcl_UniChar though) (hobbs) - -2001-05-30 (new feature)[TIP 15] Tcl_GetMathFuncInfo, Tcl_ListMathFuncs, -Tcl_InfoObjCmd, InfoFunctionsCmd APIs (fellows) - -2001-06-08 (bug fix,feature enhancement)[219170,414936] all Tcl_Panic -definitions brought into agreement (porter) - -2001-06-12 (bug fix)[219232] regexp returned non-matching sub-pairs to have -index pair {-1 -1} (fellows) - -2001-06-27 (bug fix)[217987] corrected backslash substitution of non-ASCII -characters. (hobbs, riefenstahl) - -2001-06-28 (bug fix)[231259] failure to re-compile after cmd shadowing (sofer) - -2001-07-02 (bug fix)[227512] corrected [concat] treatment of UTF-8 strings -(hobbs, barras) - -2001-07-12 (new feature)[TIP 36] Tcl_SubstObj API (fellows) - -2001-07-16 (bug fix) corrected thread-enabled pipe closing on Windows -(hobbs, jsmith) - -2001-07-18 (bug fix)[427196] corrected memory overwrite error when buffer size -of a channel is changed after channel use has already begun (kupries, porter) - -2001-07-31 (new feature)[TIP 17] TclFS* APIs provide new virtual file -system. This includes the addition of 'file normalize', 'file system', -'file separator' and 'glob -tails' (darley) - -2001-08-06 (bug fix) removed use of tmpnam in TclpCreateTempFile on Unix (lim) - - * improved build support for IRIX, GNU HURD, Mac OS 9 and OS X - - * configure scripts revamped for better support of cygwin and gcc on - Windows (mdejong) - - * corrected several minor errors noted by Purify (hobbs) - ---- Released 8.4a3, August 6, 2001 - -2001-06-27 (bug fix)[217987] corrected backslash substitution of non-ASCII -characters. (hobbs, riefenstahl) - -2001-06-28 (bug fix)[231259] failure to re-compile after cmd shadowing (sofer) - -2001-07-02 (bug fix)[227512] corrected [concat] treatment of UTF-8 strings -(hobbs, barras) - -2001-07-16 (bug fix) corrected thread-enabled pipe closing on Windows -(hobbs, jsmith) - -2001-07-18 (bug fix)[427196] corrected memory overwrite error when buffer size -of a channel is changed after channel use has already begun (kupries, porter) - -2001-08-06 (bug fix)[442665] corrected object reference counting in [gets] -(jikamens) - -2001-08-06 (new feature) added GNU (HURD) configuration target. (brinkmann) - -2001-08-07 (bug fix)[406709] corrected panic when extra items left on the -byte compiler execution stack (see test foreach-5.5) (sofer, tallneil, jstrot) - -2001-08-08 (new features) updated packages msgcat 1.1.1, opt 0.4.3, -tcltest 1.0.1, dependencies checked (porter) - -2001-08-20 (new feature)[452217] http 2.3.2: include port number in Host: header -to comply with HTTP/1.1 spec (RFC 2068) (hobbs, tils) - -2001-08-23 (new feature) added QNX-6 build support (loverso) - -2001-08-23 (bug fix) corrected handling of spaces in path name passed to -[exec] on Windows (kenpoole) - -2001-08-24 (bug fix) corrected [package forget] stopping on non-existent -package (porter) - -2001-08-24 (bug fix) corrected construction of script library search path -relative to executable (porter) - -2001-08-24 (bug fix) [auto_import] now matches patterns like -[namespace import], not like [string match] (porter) - **** POTENTIAL INCOMPATABILITY **** - -2001-08-27 (new feature) added Tcl_SetMainLoop() to enable loading Tk as a -true package (hobbs) - -2001-08-30 (bug fix) build support for Crays (andreasen) - -2001-09-01 (bug fix) rewrite of Tcl_Async* APIs to better manage thread -cleanup (gravereaux) - -2001-09-06 (new feature) http 2.4: honor the Content-encoding and charset -parameters; add -binary switch for forcing the issue (hobbs, saoukhi, orwell) -=> http 2.4 - -2001-09-06 (performance enhancement) rewrite of file I/O flush management on -Windows. Approximately 100x speedup for some operations. (kupries, traum) - -2001-09-10 (bug fix) corrected finalization error in TclInExit (darley) - -2001-09-10 (bug fix) protect against alias loops (hobbs) - -2001-09-12 (bug fix) added missing #include in tclLoadShl.c (techentin) - -2001-09-12 (bug fix) script library path construction on Windows no longer -uses registry, nor adds the current working directory to the path (porter) - -2001-09-12 (bug fix) correct bugs in compatibility strtod() (porter) - -2001-09-13 (bug fix) Tcl_UtfPrev now returns the proper location when the -middle of a UTF-8 byte is passed in (hobbs) - -2001-09-19 (bug fix) [format] and [scan] corrected for 64-bit machines (rmax) - -2001-09-19 (new feature) --enable-64-bit support for HP-11. (hobbs) - -2001-09-19 (new feature) native memory allocator now default on Windows -(hobbs) - -2001-09-20 (new feature) WIN64 support and extra processor definitions -(hobbs, mstacy) - -2001-09-26 (bug fix) corrected potential deadlock in channels that do not -provide a BlockModeProc (kupries, kogorman) - -2001-10-03 (new feature) WIN64 build support (hobbs) - -2001-10-03 (bug fix) correction in thread finalization (rbrunner) - -2001-10-04 (new feature) updated encodings with latest mappings from -www.unicode.org (hobbs) - -2001-10-11 (bug fix) corrected cleanup of self-referential bytecodes at -interpreter deletion (sofer, rbrunner) - -2001-10-16 (new feature) config support for MacOSX / Darwin (steffen) - -2001-10-16 (new feature, Mac) change in binary extension format from MachO -bundles to standard .dylib dynamic libraries like on other unices. - *** POTENTIAL INCOMPATIBILITY *** - -2001-10-18 (bug fix) corrected off-by-one-day error in clock scan with -relative months and years during swing hours. (lavana) - ---- Released 8.3.4, October 19, 2001 - -2001-08-21 (bug fix)[219184] overagressive compilation of [catch] (sofer) - -2001-08-22 (new feature)[227482] [dde request -binary] (hobbs) -=> dde 1.2 - -2001-08-30 (performance enhancement)[456668] fully qualified command names use -cached Command for all namespaces, avoiding repeated lookups (sofer) - -2001-08-31 (performance enhancement) bytecompiled [list] (hobbs) - -2001-09-02 (bug fix)[403553] Add -Zl to VC++ compile line for tclStubLib to -avoid any specific C-runtime library dependence. (gravereaux) - -2001-09-05 (new feature) restored support for Borland compiler (gravereaux) - -2001-09-05 (new feature)[TIP 49] Tcl_OutputBuffered API (schroedter, fellows) - -2001-09-07 (new feature) restored VC++ 5.0 compatibility (gravereaux) - -2001-09-10 (performance enhancement)[TIP 53,451441] [proc foo args {}] now -compiles to 0 bytecodes (sofer) - -2001-09-13 (new feature)[TIP 56] Tcl_EvalTokensStandard API (sofer) - -2001-09-17 (new feature) compiling with TCL_COMPILE_DEBUG now required to -enable all compile and execution tracing (sofer) - *** POTENTIAL INCOMPATIBILITY *** - -2001-09-19 (bug fix)[411825] made TclNeedSpace UTF-8 aware (fellows) - -2001-09-19 (bug fix)[219166] overagressive compilation of "quoted" bodies of -[for], [foreach], [if], and [while] (sofer) - -2001-09-19 (performance enhancement) bytecompiled [string match] (hobbs) - -2001-10-15 (new feature)[TIP 35] serial channel configuration: Win (schroedter) - -2001-11-06 (bug fix)[478856] loss of fileevents due to short reads (kupries) - -2001-11-06 (new feature) revitalized makefile.vc (gravereaux) - -2001-11-07 (new feature) Cygwin gcc support dropped. Use mingw (dejong) - *** POTENTIAL INCOMPATIBILITY *** - -2001-11-07 (new feature) Support --include-dir= and --libdir= options to -configure. Store in tclConfig.sh as TCL_INCLUDE_SPEC and TCL_LIB_SPEC. -(dejong) - *** POTENTIAL INCOMPATIBILITY *** - -2001-11-08 (new feature) Enable --enable-threads on FreeBSD (dejong) - -2001-11-08 (new feature) New make target 'make gdb' (dejong) - -2001-11-09 (bug fix)[480176] [global] mishandled varnames matching :* (porter) - -2001-11-12 (new feature)[TIP 22,33,45] new command [lset], -[lindex] extended to accept multiple indices. (kenny, hobbs) - -2001-11-16 (new feature) new configure option --enable-langinfo=no. -By default, nl_langinfo() is used on Unix to determine system encoding. -Tcl's built-in system is used only if that fails, or configured with ---enable-langinfo=no. (hobbs, wagner) - -2001-11-19 (new feature)[TIP 62] A Tcl_VarTraceProc can now return Tcl_Obj * -or a dynamic string as well as a static string to indicate an error (fellows) - -2001-11-19 (new feature)[TIP 73] Tcl_GetTime API (kenny) - -2001-11-19 (bug fix)[478847] overflows in [time] of >2**31 microseconds (kenny) - -2001-11-29 (performance enhancement) caching scheme added to [binary scan] -(fellows) - -2001-12-05 (new feature) new algorithm for [array get] adds safety when read -traces modify the array. (sofer) - *** POTENTIAL INCOMPATIBILITY *** - -2001-12-10 (bug fix)[490514] doc fixes (porter,english) - -2001-12-18 (new feature) removed unix/dltest/configure; unix/configure does -all (dejong) - -2001-12-19 (new feature) New make target 'make shell' (dejong) - -2001-12-21 (new feature) MaxOSX / Darwin support (steffen) - -2001-12-28 (new feature) new command [memory onexit] replaces [checkmem] when -compiled with TCL_MEM_DEBUG. Added documentation. (porter) - *** POTENTIAL INCOMPATIBILITY *** - -2001-12-28 (bug fix) proper case in [auto_execok] use of $env(COMPSPEC) (hobbs) - -2002-01-05 (feature rewrite) Tcl_Main() rewritten and documentation improved. -Interactive operation and event loop operation (via Tcl_SetMainLoop) now -interleave cleanly. Also more robust against strange happenings. (porter) - -2002-01-17 (bug fix)[504642] Tcl_Obj refCounts in [gets] (griffen,kupries) - -2002-01-21 (bug fix)[506297] infinite loop writing in iso2022-jap encoding -(forssen,kupries) - -2002-01-24 (HTTP server bug workaround)[504508] leave the default port out -of the Host: header value -=> http 2.4.1 (hobbs) - -2002-01-25 (new feature)[496733] socket options -eofchar and -translation -return read-only values (dejong) - -2002-01-28 (performance enhancement) bytecompiled [regexp] for trivial cases -that amount to string matching. Also -nocase and --. (hobbs) - -2002-02-05 (bug fix) [http::error] called when [::error] intended -=> http 2.4.2 (porter) - -2002-02-05 (bug fix)[465765] avoid zero-byte writes to STREAMs -(talcott,kupries) - -2002-02-06 (performance enhancement) [regsub] special cases that map to -[string map] detected. (hobbs) - -2002-02-06 (bug fix)[495213] [scan] accept 0x as prefix of base 16 value -(hobbs) - -2002-02-10 (new feature)[TIP 32,79] Tcl_CreateObjTrace API (kenny) - -2002-02-12 (new feature) partial support for DJGPP Tcl on DOS (gravereaux) - -2002-02-14 (mem leak) Fixed leaking an empty Tcl_Obj when [gets $chan] -errored out. (kupries, sofer) - -2002-02-15 (new feature)[TIP 72] support for 64-bit integer values on -32-bit platforms and ability to work with >2GiB files. Extends many -commands. See TIP for details. - *** POTENTIAL INCOMPATIBILITY *** - -2002-02-22 (bug fix)[476537] Fix panic when loading shared library without -proper use of stubs on platform without backlinking (porter) - -2002-02-22 (new feature) 64-bit support for xlc compiler on AIX-4 (hobbs) - -2002-02-22 (new feature)[521560] Removed limits on filename length and -format [source]able through the Safe Base (hobbs) - -2002-02-22 (performance enhancement) optimized bytecodes for [if], [for], -[while] and constant conditions (sofer) - -2002-02-22 (new feature)[TIP 76] [regsub] can now return result (fellows) - -2002-02-25 (bug fix)[495207] buffer overrun when closing ] left out of -argument to [subst] (sofer, english) - -2002-02-25 (bug fix)[514392] [load] updated for Mac OS X 10.1 (steffen) - -2002-02-26 (bug fix) [info hostname] choked on names >31 characters (hobbs) - -2002-02-26 (new feature)[TIP 35] serial channel configuration: Unix -(schroedter, hobbs) - -2002-02-25 (bug fix)[483575] [fconfigure ... -error] now no-op on Mac (kupries) - -2002-02-28 (performance enhancement)[458872] fully qualified command names use -cached Command for all namespaces, avoiding repeated lookups (sofer) - - * (new feature)[TIP 27] completed CONST-ification of TCL APIs. -Added compiler macro USE_NON_CONST to keep using those old API prototypes -that present irreconcilable source incompatibilities with header files -of prior Tcl releases. Others will need to be reconciled. - *** POTENTIAL INCOMPATIBILITY *** - -2002-03-04 (bug fix)[474358, 218099, 219314, 524674] fixed several problems -related to the handling of iso2022 text and finalization of escape-based -encodings. (taguchi, takahashi, hobbs) - ---- Released 8.4a4, March 5, 2002 - -2002-03-06 (new feature)[TIP 80] expanded [lsearch] options (wilkason, fellows) - -2002-03-07 (new feature)[TIP 87] [interp recursionlimit] (trier) - -2002-03-08 (platform feature) mingw 1.1 build favored (dejong) - -2002-03-20 (new feature)[TIP 27] CONST-ified variable access functions (porter) - -2002-03-24 (bug fix)[511666,511658,523217,530960] expanded -Tcl_FSMatchInDirectory to handle assorted [glob] bugs in VFS. (darley) - *** POTENTIAL INCOMPATIBILITY with prior 8.4a releases *** - -2002-03-25 (bug fix)[495726] stopped tcltest disabling of auto-loading (porter) - -2002-03-25 (bug fix)[495977] allow \n in test constraints (porter) - -2002-03-27 (platform support)[527941,533862] VC/winhelp/W9X (spjuth, -gravereaux) - -2002-03-28 (bug fix)[219181] exception at level 0 issues (sofer) - -2002-03-28 (bug fix)[219362] command termination; Tcl_CreateTrace (knoll,sofer) - -2002-04-05 (bug fix)[536879] exceptions during variable subst (porter) - -2002-04-15 (bug fix)[497446,513983] tcltest syntax errors now raised (porter) - ***POTENTIAL INCOMPATIBILITY with prior tcltest 2.0.* (8.4aX)*** - -2002-04-17 (bug fix)[495660] [(save|restore)state] deprecated (porter) - -2002-04-17 (bug fix)[526524] escape-based encodings corrected (yamamoto, hobbs) - -2002-04-18 (bug fix)[542588] [expr] error msgs improved (ehrens, sofer) - -2002-04-18 (bug fix)[545325] [info level $level] now returns [namespace eval] -as documented (suchenwirth,sofer) - -2002-04-19 (bug fix)[544727] export [mcload]; ns context of [mcmax] (porter) -=> msgcat 1.2.3 - -2002-04-22 (performance enhancement) threaded memory allocator (AOL, hobbs) - -2002-04-24 (new feature) TCLTK_NO_LIBRARY_TEXT_RESOURCES #define disables -inclusion of tcl library code in resource fork on Mac. (steffen) - -2002-05-21 (platform support) static libs on OSF (dejong) - -2002-05-24 (bug fix)[557878] set encoding on listening socket (staplin, -kupries) - -2002-05-24 (new feature)[TIP 91] Tcl_Seek compatibility (fellows) - -2002-05-28 (bug fix)[545579] VFS [load] left temp file (darley) - -2002-05-28 (bug fix)[559376] plug timezone env leak on Windows (hobbs) - -2002-05-29 (performance enhancement) [string compare] optimized (hobbs,fellows) - -2002-05-31 (bug fix)[550534] plug interp leak in [pkg_mkIndex] (helmut) - -2002-05-31 (dead code)[474335,555635] removed all use of matherr() (english) - *** POTENTIAL INCOMPATIBILITY *** - -2002-06-04 (new feature)[TIP 85,521362] custom result match in tcltest -(markus, porter) -=> tcltest 2.1 - -2002-06-06 (bug fix)[524352] encoding, threading, and environment issues on -MacOSX (steffen) - -2002-06-06 (bug fix)[512214,558742,512214,461000] lazy initialization of -tcltest constraints (porter) - -2002-06-07 (bug fix)[563122,564595] EOVERFLOW definitions (fellows) - -2002-06-11 (bug fix)[567386] [info locals] corrections (sofer) - -2002-06-14 (new feature)[TIP 102] [trace list] renamed [trace info] (fellows) - -2002-06-17 (new feature)[525522,525525] msgcat support for XPG4 locales; -examination of LC_ALL, LC_MESSAGES environment variables (haible, porter) -=> msgcat 1.3 - -2002-06-17 (new feature)[565088] header files assume modern C compiler by -default; older compilers may need configuration (english) - *** POTENTIAL INCOMPATIBILITY *** - -2002-06-17 (bug fix)[554068] [exec] argument quoting on Windows (darley) - -2002-06-17 (new feature)[TIP 62,462580] command execution traces (lavana) - -2002-06-19 (bug fix)[558324] regexp sets a linked variable (watson) - - * (performance enhancment) optimizations of bytecode execution (sofer) - -2002-06-21 (new feature)[TIP 99,562970] new [file link] command (darley) - -2002-06-24 (new feature)[TIP 101] new [tcltest::configure] command (porter) -=> tcltest 2.2 - -2002-06-25 (new feature) --enable-man-symlinks and --enable-man-compression -options to configure (max) - -2002-06-26 (bug fix)[565880] [clock format] now respects locale (max) - *** POTENTIAL INCOMPATIBILITY *** - -2002-07-03 (bug fix)[577015] [catch] catches even compile errors (sofer) - ---- Released 8.4b1, July 5, 2002 - -2002-07-08 (bug fix) restored compatibility of [viewFile] in tcltest (porter) - -2002-07-11 (bug fix) [file normalize] returns long form on Win 95/98/ME (darley) - -2002-07-15 (performance enhancment) variable operations rewritten to store - and use cached Var pointers (sofer) - -2002-07-22 (bug fix)[218000] Inf and Nan are floating-point values (fellows) - -2002-07-23 (platform support)[219220] 64-bit compile on IRIX (dejong) - -2002-07-25 (bug fix)[219218] return codes in background errors (english) - -2002-07-28 (bug fix)[582522] alias fires exec traces (sofer) - -2002-07-29 (bug fix)[578363] regexp (fellows,pvgoran) - -2002-07-30 (bug fix)[584603] WriteChars infinite loop non-UTF-8 string (kupries) - -2002-08-04 (new feature)[584051,580433,585105,582429][TIP 27] Tcl interfaces - are now fully CONST-ified. Use the symbols USE_NON_CONST or - USE_COMPAT_CONST to select interfaces with fewer changes. - *** POTENTIAL INCOMPATIBILITY *** - -2002-08-05 (bug fix)[589859] tcltest setup and cleanup scripts skipped when - test body is skipped (porter) - => tcltest 2.2 - -2002-08-07 (bug fix)[587488] mem leak with USE_THREAD_ALLOC (sofer,sass) - -2002-08-07 (feature enhancement)[584794,584650,472576] boolean values - are no longer always re-parsed from string. (sofer) - -Many internal bugs fixed. -Considerable cleanup of the test suite. - ---- Released 8.4b2, August 9, 2002 - -2002-08-20 (new feature) --enable-memdebug configure option (kupries) - -2002-08-23 (bug fix)[597936] mem leak with USE_THREAD_ALLOC (sofer,zoran) - -2002-08-26 (bug fix)[599788] segfault in compiler (sofer,wilkason) - -2002-08-28 (bug fix)[414910] avoid mem leaks accessing environment variables - on Windows (welton,gravereaux) - -2002-08-31 (platform support)[TIP 108] Mac OS X port (steffen,ingham) - -2002-09-02 (platfrom support) 64-bit compile on HP-11 (martin) - ---- Released 8.4.0, September 10, 2002 - -2002-09-18 (platform support) Updated support for compiling with Cygwin and -either mingw or gcc. (khan, howell, dejong) - -2002-09-22 (bug fix)[612786, 611922] Corrected [puts -nonewline] within -test bodies. Also corrected reporting of body return code. Updated tcltest -to v2.2.1. - -2002-09-24 (bug fix)[613117] More robust 64-bit wide integer value -detection (fellows) - -2002-09-26 (bug fix) correct overeager optimization of noop proc to handle -the precompiled case. (sofer, hobbs) - -2002-09-26 (bug fix)[615115] removed extraneous spaces in koi8-u.enc that -confused encoding reader. - -2002-09-29 (bug fix)[219355] Added proper exiting conditions using Win32 -console signals. This handles the existing lack of a Ctrl+C exit to call -exit handlers when built for thread support. Also, properly handles exits -from other conditions such as CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT, and -CTRL_SHUTDOWN_EVENT signals. In all cases, exit handlers will be called. -(gravereaux) - -2002-09-30 (bug fix) improve the checking for bad regular expressions -during regexp compilation. Resultant compiles were correct, but much -slower than necessary. (hobbs) - -2002-10-01 (bug fix) fix precompiled locals to support 8.3 precompiled -code. (hobbs) - -2002-10-09 (bug fix)[620735] Added code to set an exit handler on Windows -that terminates the thread that calibrates the performance counter, so that -the thread won't outlive unloading the Tcl DLL. (kenny) - -2002-10-09 (build support) all --enable-symbols to take the enhanced -options yes|no|mem|compile|all. (hobbs) - -2002-10-10 (build support) enable USE_THREAD_ALLOC (new threaded allocator) -by default on Windows. (hobbs, gravereaux) - -2002-10-14 (bug fix)[623269] correct possible mem leak in -Tcl_PutEnv. (brouwers) - -2002-10-15 (bug fix)[615043] fix in execution traces with idle tasks -firing. (lavana) - -2002-10-15 (platform support) Correct AIX-5 ppc and 4/5 64-bit build flags. -Correct HP 11 64-bit gcc building. (martin, hobbs) - -2002-10-17 (bug fix)[624755] Fixed code that check for proper # of args to -[array names] (porter) - -2002-10-18 (feature enhancement)[625453] Added support for broadcasting -changes to the registry Environment on Windows. Updated registry package -to v1.1. (hobbs) - -2002-10-22 (platform support)[624509] On macosx, add embedded framework -dirs to tcl_pkgPath: @executable_path/../Frameworks and -@executable_path/../PrivateFrameworks (if they exist), as well as the dirs -in DYLD_FRAMEWORK_PATH (if set). (steffen) - ---- Released 8.4.1, October 22, 2002 - -2002-10-28 (bug fix)[627660] [package unknown] chaining for platform specifics - -2002-10-29 (bug fix)[627546] verbose [load] (dyld) error mesages on MacOSX - -2002-11-01 (bug fix) [package provide registry] consistent versions. - -2002-11-06 (bug fix)[582039] missing ar program -> configuration error - -2002-11-06 (feature enhancement) added new TclInThreadExit function to -test for thread exit vs whole process exit condition. The TclInExit -function now correctly returns 1 during Tcl_Finalize processing. - *** POTENTIAL INCOMPATIBILITY *** - -2002-11-13 (bug fix)[615043] some execution traces were not firing - -2002-11-18 (bug fix)[634856] multiple signs no longer accepted as valid integer -[string is integer ++1] => 0 - *** POTENTIAL INCOMPATIBILITY *** - -2002-11-26 (bug fix)[593810,597924] clean exit of channel worker threads on Win - -2002-11-28 (new feature) `make valgrind` target - -2002-12-03 (bug fix)[615304] repeated load/unload of Tcl now possible - -2002-12-11 (bug fix)[647307] negative return codes now propagated by procs - -2002-12-11 (bug fix)[648441] syntax error in [expr 0x] now detected. - -2003-01-07 (bug fix)[633204] [catch {return}] => 2 (not 0) - -2003-01-09 (bug fix)[634151] [file (a|m)time $nonASCIIpath $time] now works - -2003-01-16 (bug fix) dde eval with {} service name does not crash. -=> dde 1.2.1 - -2003-01-16 (bug fix)[635200,655645,615043,571385] many command trace fixes - -2003-01-31 (bug fix)[675614,678415,676978] tcltest conflicts in cleanup -and -outfile; also failure in space-containing path; also missing [close] -=> tcltest 2.2.2 - -2003-02-01 (bug fix)[670042] corrected [info loaded {}] for static -packages in multiple interps. - -2003-02-01 (bug fix)[675356] [clock clicks {}]; [clock clicks -] - syntax errs - -2003-02-01 (bug fix)[656660] MT-safety for [clock format] - -2003-02-03 (bug fix)[651271] command rename traces get fully-qualified names - *** POTENTIAL INCOMPATIBILITY *** - -2003-02-07 (performance improvement) [glob] on Windows is 2.5 times faster - -2003-02-07 (feature change) lack of Cygwin support indicated by config error - -2003-02-11 (bug fix)[684744] [info complete] stopped by \x00 - -2003-02-11 (bug fix)[685445] [glob -types l] missed broken symlinks on Unix - -2003-02-11 (bug fix) [lsearch -regexp $a $a] doesn't crash - -2003-02-13 (bug fix)[685926] accept non-ASCII7 for tcl_platform(user) on Win - -2003-02-15 (bug fix)[673714] stop crash when Tcl_DeleteEvents deletes last - -2003-02-15 (bug fix)[681841] parser missed some missing ] syntax errors - -2003-02-17 (bug fix)[684756] memory leak during command rename plugged - -2003-02-18 (bug fix)[689100] reduced per-thread memory overhead - -2003-02-18 (platform support)[651811] use xnet library on HP 11 (64 bit). - -2003-02-20 (bug fix)[Patch 689341] correct jis round-trip encoding - -2003-02-20 (bug fix)[689835] stop MacOSX hang trying to read a write-only pipe - -2003-02-07 (performance improvement) [tclPkgUnknown]: fewer vfs calls - -2003-02-18 (platform support) cut and splice procs for file channels on Mac - -2003-02-21 (bug fix)[690774] [binary scan] failed on some wide ints - -2003-02-22 (bug fix)[571002] plugged data leak during thread exit - -2003-02-25 (feature change) [pkg_mkIndex -load]: case-insensitive match - *** POTENTIAL INCOMPATIBILITY *** - -2003-02-27 (bug fix)[694232] stop [lsearch -start 0 {} x] segfault - ---- Released 8.4.2, March 3, 2003 - -2003-03-06 (bug fix)[699042] Correct case-insensitive unicode string -comparison in Tcl_UniCharNcasecmp - -2003-03-11 (bug fix) Corrected loading of tclpip8x.dll on Win9x - -2003-03-12 (bug fix)[702383] Corrected parsing of interp create -- - -2003-03-12 (bug fix)[685106] Correct Tcl_SubstObj handling of \x00 bytes - -2003-03-14 (bug fix)[702622 699060] Correct wide int issues in 'format' - -2003-03-14 (bug fix)[698146] Remove assumption that file times and longs -are the same size. - -2003-03-18 (bug fix)[697862] Allow Tcl to differentiate between reparse -points which are symlinks and mounted drives on Windows - -2003-03-19 (bug fix)[705406] Bad command count on TCL_OUT_LINE_COMPILE - -2003-03-20 (bug fix)[707174] Store pointers to notifier funcs in a struct -to work around some platform linker issues - -2003-03-22 (bug fix)[708218] Load correct (non-)debug dll for dde or -registry - -2003-03-24 (bug fix)[631741 696893] Fixing ObjMakeUpvar's lookup algorithm -for the created local variable - -2003-04-07 (bug fix)[713562] Make sure that tclWideIntType is defined and -somewhat sensible everywhere - -2003-04-07 (bug fix)[711371] Corrected string limits of arguments -interpolated in error messages for 'if' - -2003-04-11 (bug fix)[718878] Corrected inconsistent results of -[string is integer] observed on systems where sizeof(long) != sizeof(int) - -2003-04-12 (bug fix) Substantial changes to the Windows clock synch -phase-locked loop in a quest for improved loop stability - -2003-04-16 [713562] Made changes so that the "wideInt" Tcl_ObjType is -defined on all platforms, even those where TCL_WIDE_INT_IS_LONG is defined. -Also made the Tcl_Value struct have a wideValue field on all platforms. -Potential incompatibility for TCL_WIDE_INT_IS_LONG platforms because that -struct changes size. - *** POTENTIAL INCOMPATIBILITY *** - -2003-04-25 (bug fix)[727271] Catch any errors returned by the Windows -functions handling TLS ASAP instead of waiting to get some mysterious crash -later on due to bogus pointers. - -2003-04-29 (bug fix) Correct 'glob -path {[tcl]} *', where leading -special character instead lists files in '/'. Bug only occurs on Windows -where '\' is also a directory separator. - -2003-05-09 (bug fix)[731754] Fixed memory leak in threaded allocator on -Windows caused by treating cachePtr as a TLS index - -2003-05-10 (bug fix)[710642] Ensure cd is thread-safe - -2003-05-10 (bug fix)[718002] Correct mem leak on closing a Windows serial -port - -2003-05-10 (bug fix)[714106] Prevent string repeat crash when overflow -sizes were given (throws error). - -2003-05-13 (feature enhancement)[736774] Use new versioned bundle resource -API to get tcl runtime library for TCL_VERSION on Mac OS X. - -2003-05-13 (bug fix)[711232] Worked around the issue of realpath() not -being thread-safe on Mac OS X by defining NO_REALPATH for threaded builds -on Mac OS X. - -2003-05-14 (bug fix)[557030] Correct handling of the gb2312 encoding by -making it an alias of the euc-cn encoding and creating a gb2312-raw -encoding for the original. Most uses of gb2312 really mean euc-cn. - -2003-05-14 (bug fix)[736421] Corrected another putenv() copy behavior -problem when compiling on Windows and using Microsoft's runtime. - ---- Released 8.4.3, May 20, 2003 - -2003-05-23 (bug fix)[726018] reverted internals change to the -'cmdName' Tcl_ObjType that broke several extensions (TclBlend, e4graph...) -in the 8.4.3 release. - -2003-06-10 (bug fix)[495830] stop eval of bytecode in deleted interp. - -2003-06-17 (bug fix) corrections to regexp when matching emtpy string. - -2003-06-25 (bug fix)[748957] -*ieee compiler flags for Tru64 builds. - -2003-07-11 (bug fix) [pkg_mkIndex] indexes provided packages, not indexed ones. - -2003-07-15 (feature enhancement) MacOSX build system rewrite. - -2003-07-15 (bug fix)[771613] corrected segfault in [if] (buffer overflow) - -2003-07-16 (bug fix)[756791] corrected assumption that Tcl_Free == free - -2003-07-16 (feature enhancement) -DTCL_UTF_MAX=6 compile option forces -internal UCS-4 representation of Unicode (default is recommended UCS-2). - -2003-07-16 (bug fix)[767578] 64-bit corrections in thread notifier. - -2003-07-16 (bug fix)[759607] Safe Base tests normalized paths. - -2003-07-16 (feature enhancement)[Patch 679315] improved Cygwin path support - -2003-07-18 (bug fix)[706359] corrected broken -output option of [tcltest::test] -=> tcltest 2.4.4 - -2003-07-18 (bug fix)[753315] MT-safety of VFS records. - -2003-07-18 (bug fix)[759888] support for user:pass in URL by [http::geturl] -=> http 2.4.4 - -Improved documentation, new tests, and some code cleanup. -[655300, 720634, 735364, 748700, 756112, 756744, 756951, 758488, 760768, -763312, 769895, 771539, 771840, 771947, 771949, 772333] - ---- Released 8.4.4, July 22, 2003 - -2003-07-23 (bug fix)[775976] fix registry compilation for VC7. - -2003-08-05 (enhancement)[781585] Use Tcl_ResetResult in bytecodes to -prevent potential costly Tcl_Obj duplication. - -2003-08-06 (bug fix)[781609] prevent non-Windows platforms from trying to -use the registry package inside msgcat. - -2003-08-27 (bug fix)[411825] Fix TclNeedSpace to handle non-breaking space -(\u00A0) and backslash escapes correctly. - -2003-09-01 (bug fix)[788780] Fix thread-safety issues in filesystem records. - -2003-09-19 (bug fix)[804681] Protect ::errorInfo and ::errorCode traces -from corrupting stack. - -2003-09-23 (bug fix)[218871] Fix handling of glob-sensitive chars in -auto_load and auto_import. - -2003-10-03 (bug fix)[811483] Fixed refcount management for command and -execution traces. - -2003-10-04 (bug fix)[789040] Fixed exec command.com error for Win9x. - -2003-10-06 (bug fix)[767834, 813273] Fixed volumerelative file -normalization and 'file join' inconsistencies. - -2003-10-08 (bug fix)[769812] Fix Tcl_NumUtfChars string length calculation -when negative parameter is given. - -2003-10-22 (bug fix)[800106] Handle VFS mountpoints inside glob'd dirs. - -2003-10-22 (bug fix)[599468] Watch for FD_CLOSE too on Windows when -asked for writable events by the generic layer. - -2003-10-23 (bug fix)[813606] Detect OS X pipes correctly. - -2003-11-05 (bug fix)[832657] Allow .. in libpath initialization. - -2003-11-11 (bug fix) Improve AIX-64 build configuration. - -2003-11-17 (bug fix)[230589, 504785, 505048, 703709, 840258] fixes to -various odd regexp "can't happen" bugs. - ---- Released 8.4.5, November 20, 2003 - -2003-12-02 (bug fix)[851747] object sharing fix in [binary scan] - -2003-12-09 (platform support)[852369] update errno usage for recent glibc - -2003-12-12 (bug fix)[858937] fix for [file normalize ~nobody] - -2003-12-17 (bug fix)[839519] fixed two memory leaks (vasiljevic) - -2004-01-09 (bug fix)[873311] fixed infinite loop in TclFinalizeFilesystem - -2004-02-02 (bug fix)[405995] Tcl_Ungets buffer filling fix - -2004-02-04 (bug fix)[833910] tcltest command line option parsing error -=> tcltest 2.4.5 - -2004-02-04 (bug fix)[833637] code error in tcltest -preservecore operation - -2004-02-12 (feature enhancement) update HP-11 build libs setup - -2004-02-17 (bug fix)[849514,859251] corrected [file normailze] of $link/.. - -2004-02-17 (bug fix)[772288] Unix std channels forced to exist at startup. - -2004-02-17 (new default) tcltest::configure -verbose {body error} - -2004-02-19 (bug fix) init.tcl search path with unusual --libdir (samson) - -2004-02-25 (bug fix)[554068] stopped broken [exec] quoting of { (gravereaux) - -2004-02-25 (bug fix)[888777] plugged memory leak with long host names (cassoff) - -2004-03-01 (bug fix)[462580] corrected level interpretation of Tcl_CreateTrace - -2004-03-01 (platform support)[218561] Allow 64-bit configure on IRIX64-6.5* - ---- Released 8.4.6, March 1, 2004 - -Changes to 8.5a1 include all changes to the 8.4 line through 8.4.6, -plus the following, which focuses on the high-level feature changes -in this changeset (new minor version) rather than bug fixes: - - * refactored IO code to split FS path code into generic/tclPathObj.c - and generic/tclFileSystem.h - - * refactored trace code into generic/tclTrace.c - - * configure scripts now require autoconf 2.57 for regeneration - - * updated runtime library scripts to use newer Tcl code features - (like replacing regsub with string map) - - * improve robustness of tcltest test suite across environments - - * changed the bytecode evaluation-stack addressing mode, from array-style - to pointer-style; the catch stack and evaluation stack are now - contiguous in memory - - * switch command is now byte-compiled - - * enhanced checking in 'file' command for Windows NT file permissions - - * [TIP #57] new 'lassign' command (adopted from TclX) - - * [TIP #75] switch -regexp now provides submatch info - - * [TIP #90] extended 'catch' and 'return' to enable creation of procs - that are a true replacement for 'return' - - * [TIP #100] new 'unload' command (can unload DLLs loaded via 'load', - requires the extension writer to support it) - - * [TIP #111] new 'dict' command. Several commands have been updated - to handle the list form of dicts implicitly at the C level where - only lists were previously accepted - - * [TIP #112] 'namespace ensemble' command addition allows for ensembles - that build on the namespace abstraction - - * [TIP #118] file attributes -readonly option for unices that support - chflags(), support Mac Classic attribute options on OS X, add - -rsrclength for OS X, enhance file copy on OS X to copy finder - attributes and resource forks transparently - - * [TIP #120] enable dde in safe interpreters - * [TIP #130] enable unique dde server names on Windows - * [TIP #135] change dde servername -exact option to -force -=> dde 1.3 - - * [TIP #121] new Tcl_SetExitProc C API to control application shutdown - - * [TIP #123] expr ** exponentiation operator - - * [TIP #124] 'clock clicks -milliseconds' now returns a wide integer and a - new 'clock clicks -microseconds' returns a wide integer, representing - the number of microseconds, both since the Posix epoch - - * [TIP #127] added 'lsearch -index' option - - * [TIP #136] added 'lrepeat' command - - * [TIP #137/151] Add -encoding option to 'source' command and main tclsh - executable. - *** POTENTIAL INCOMPATIBILITY *** - For Tcl embedders that build on Tcl_Main() and make use of Tcl_Main's - former ability to pass a leading "-encoding" option to interactive shell - operations, this will now be consumed by Tcl. - - * [TIP #138] New TCL_HASH_KEY_SYSTEM_HASH option for Tcl hash tables - - * [TIP #139] documented portions of Tcl's namespace C APIs - - * [TIP #148] correct [list]-quoting of the '#' character - *** POTENTIAL INCOMPATIBILITY *** - For scripts that assume a particular (buggy) string rep for lists. - - * [TIP #156] add "root locale" to msgcat -=> msgcat 1.4 - - * [TIP #157] leading {expand} syntax on words to cause argument expansion. - This is a safer/cleaner alternative to the use of 'eval'. - ---- Released 8.5a1, March 3, 2004 - -2004-03-04 (new feature) registry package is [unload]able (thoyts) -=> registry 1.1.4 - -2004-03-08 (bug fix)[910525] [glob -path] in root directory (darley) - -2004-03-12 (new feature)[TIP 163] [dict merge] (english, fellows) - -2004-03-18 (platform support) support for Mac Classic removed (steffen) - -2004-03-28 (bug fix)[925121] corrected segfault in bc compiler (sofer) - -2004-03-30 (bug fix)[495830,729692] bytecode execution checks -each command/interp validity before executing. (sofer) - -2004-03-31 (bug fix)[811457] support translation to "" (porter) -2004-03-31 (bug fix)[811461] ignore locales with no "language" part (porter) -=> msgcat 1.4.1 - -2004-04-01 (bug fix) make [glob -type d -dir . *] work across VFS boundary - -2004-04-06 (clean up) refactored Tcl header file #include order. Might -create need for changes in extensions that #include private headers. -Changed source code files should work with older Tcl as well. - *** POTENTIAL INCOMPATIBILITY *** - -2004-04-07 (bug fix)[920667] install into any Unicode path on Win (hobbs) - -2004-04-07 (platform support) properly substitute more values in Windows -tclConfig.sh (hobbs) - -2004-04-23 (bug fix)[930851] reset channel EOF when eofchar changes (kupries) - -2004-04-28 (bug fix)[600812][TIP 184] [upvar 0 scalar array(foo)] raises error - -2004-05-03 (bug fix)[947070] stack overflow prevention on Win (kenny) - -2004-05-03 (bug fix)[868853] fix leak in [fconfigure $serial -xchar] (cassoff) - -2004-05 (bug fix)[928353,929892,928808,947440,948177] test fixes: OSX (abner) - -2004-05-05 (bug fix)[794839] socket connect error -> r/w fileevents -(gravereaux) - -2004-05-07 (bug fix)[949905] corrected utf-8 encoding of \u0000 on I/O (max) - -2004-05-13 (new feature)[TIP 129] [binary scan tnmrRqQ] (markus, fellows) - -2004-05-13 (new feature)[TIP 142] [interp limit] (fellows) - -2004-05-14 (bug fix)[940278,922848] [clock] notices $::env(TZ) changes, -gmt works on all platforms. (kenny, welton, glessner) - -2004-05-16 (feature rewrite) bytecode execution of {expand} changed - *** POTENTIAL INCOMPATIBILITY with prior 8.5a releases *** - -2004-05-18 (platform support) makefile.vc now generates tclConfig.sh (thoyts) - -2004-05-18 (bug fix)[500285,500389,852944] [clock %G %V] ISO8601 week numbers -(kenny) - -2004-05-22 (bug fix)[735335,736729] variable name resolution error (sofer) - -2004-05-24 (bug fix) support for non-WIDE_INT aware math functions (hobbs) - -2004-05-25 (new feature) [http::config -urlencoding] (hobbs) -=> http 2.5.0 - -2004-05-26 (bug fix)[960926] file count doubled when -singleproc 1 (porter) -=> tcltest 2.2.6 - -2004-05-26 (bug fix)[874058] improved build configuration on 64-bit systems. -Corrects Tcl_StatBuf definition issues. (hobbs) - -2004-05-30 (platform support) Win: allow signed short exit codes (gravereaux) - -2004-06-05 (bug fix)[976722] hi-res clock fixes: Win -(godfrey, suchenwirth, kenny) -2004-06-10 (bug fix)[932314] bad return values from Tcl_FSChdir() (vasiljevic) - -2004-06-18 (platform support) regonize more unix locales (huang) - -2004-06-18 (bug fix) prevent stack overflow from long free() chains (fellows) - -2004-06-21 (platform support) exceptions w/ gcc -O3 on Win (dejong) - -2004-06-23 (feature rewrite)[976496] thread local storage done with hash -tables to avoid system limits (mistachkin) - -2004-06-29 (bug fix)[981733] SafeBase global pollution (fellows) - -2004-06-30 (new feature)[TIP 188] [string is wideinteger] (kenny) - -2004-07-02 (new feature)[TIP 202] pipe redirection 2>@1 (hobbs) - -2004-07-03 (bug fix)[908375] round() wide integer support (lavana, sofer) - -2004-07-07 (bug fix)[458361] shimmer of single-word scripts suppressed (sofer) - -2004-07-15 (bug fix)[770053] crash in thread finalize of notifier (vasiljevic) - -2004-07-15 (bug fix)[990453] plug mutex leaks on reinit -(mistachkin, vasiljevic) - -2004-07-16 (bug fix)[990500] clean exit of notifier thread -(mistachkin, kupries) - -2004-07-19 (bug fix)[987967] improved self-init of mutexes on Win (vasiljevic) - -2004-07-20 (bug fix) pure Darwin/CFLite support (steffen) - -2004-07-20 (bug fix)[736426] plug leaky allocator reinit (mistachkin, kenny) - -2004-07-30 (bug fix)[999084] no deadlock in re-entrant Tcl_Finalize (porter) - -2004-08-02 (new feature)[TIP 207] [interp invokehidden -namespace] (porter) - -2004-08-10 (bug fix) thread IDs on 64-bit systems (ratcliff,vasiljevic) - -2004-08-13 (bug fix) avoid malicious code acceptance by [mclocale] (porter) -=> msgcat 1.3.3 - -2004-08-16 (bug fix)[1008314] Tcl_SetVar TCL_LIST_ELEMENT (sofer,porter) - -2004-08-18 (new feature)[TIP 173,209] complete [clock] rewrite (kenny) - *** POTENTIAL INCOMPATIBILITY *** - -2004-08-18 (new feature)[TIP 189] package loading for Tcl Modules (kupries) - -2004-08-19 (bug fix)[1011860] [scan %ld] fix on LP64 (fellows,porter) - -2004-08-23 (bug fix)[695441] extend [tcl_findLibrary] search path to include - $::auto_path and [pkgconfig get scriptdir,runtime] (porter) - -2004-08-27 (platform support) TCL_MODULE_PATH values for Mac OSX (steffen) - -2004-08-27 (bug fix)[1017022] recognize imported ensembles (fellows) - -2004-08-30 (bug fix) [string map $x $x] crash (fellows) - -2004-09-01 (bug fix)[1020445] WIN64 support (hobbs) - -2004-09-03 (bug fix)[1020538] crash in [file copy] (violi,fellows) - -2004-09-07 (bug fix)[1016167] [after] overwrites its imports (kenny) - -2004-09-08 (bug fix) fixed [clock format 0 -format %k] (kenny) - -2004-09-09 (bug fix)[560297] fixed broken [namespace forget] logic (porter) - -2004-09-09 (bug fix)[1017299] fixed [namespace import] cycle prevention -(porter) - -2004-09-10 (performance) $x[set x {}] is now fast [K $x [set x {}]] (sofer) - -2004-09-10 (bug fix)[868489] better control over int <-> wideInt -(fellows,kenny) - -2004-09-10 (bug fix)[1025359] POSIX errorCode from wide seeks (kupries,fellows) - -2004-09-10 (bug fix)[707104,1026493] fix [rename] of [interp alias] (porter) - -2004-09-18 (bug fix)[868467] fix [expr 5>>32] => 0, not 5 (hintermayer,fellows) - -2004-09-21 (bug fix) consistent errorinfo from [namespace eval x error foo bar] - and [namespace eval c {error foo bar}] (porter) - -2004-09-22 (feature change) syntax errors not reported at compile time; - deferred to runtime. Support [return -errorline]. (porter) - -2004-09-23 (bug fix)[1016726] fix `make clean` in static config -(leitgeb,dejong) - -2004-09-22 (feature change) report all compile errors at runtime (porter) - -2004-09-29 (bug fix)[1036649] syntax error in [subst] => buffer overflow -(sofer) - -2004-09-30 (bug fix)[1038021] save/restore error state: var traces (porter) - -2004-10-01 (performance) stackframe level values in internal reps (fellows) - -2004-10-01 (feature change)[1037235] auto-create [dict] key paths (fellows) - -2004-10-04 (bug fix)[884830] eq and ne parse in expr (fellows) - -2004-10-05 (reform) errorInfo, errorCode management (porter) - *** POTENTIAL INCOMPATIBILITY for traces on those vars *** - -2004-10-06 (feature change)[1041072] re-bless and enhance Tcl_AppendResult -(dkf) - -2004-10-06 (reform) more robust interp result appends (porter) -=> dde 1.3.1 -=> registry 1.1.5 - -2004-10-06 (reform) re-write of [glob] guts (fellows) - -2004-10-07 (reform)[925620] improved platform split of VFS code (darley) - -2004-10-08 (new feature)[TIP 201] "in" and "ni" expr operators (fellows) - -2004-10-08 (new feature)[TIP 212] [dict update]; [dict with] (fellows) - -2004-10-08 (bug fix)[954263] case insensitive [file exec] for Win -(hobbs,darley) - -2004-10-14 (performance) [info commands/globals/procs/vars $pattern] faster - when $pattern is trivial (fellows) - -2004-10-14 (new feature)[TIP 217] [lsort -indices] (salsman,fellows) - -2004-10-24 (reform) replaced bit flag values with macros for Var handling - *** POTENTIAL INCOMPATIBILITY for accesses to Var internals *** - -2004-10-26 (new feature)[1054370] install msgcat, http, tcltest as TM's -(porter) - -2004-10-26 (bug fix)[767676] negative PIDs with pipes (giese,gravereaux) - -2004-10-27 (bug fix)[731778] stop critical section leaks -(mistachkin,gravereaux) - -2004-10-27 (bug fix)[926088] -load option to find tested packages (gravereaux) - -2004-10-28 (bug fix)[1030548] restore the --enable-symbols --enable-threads -build on Win (mistachkin,kenny,kupries) - -2004-10-29 (bug fix)[1055673] fix command line syntax error message (porter) -=> tcltest 2.2.7 - -2004-10-30 (bug fix)[926106] fix [file mtime] DST anomaly (kenny) - -2004-10-31 (bug fix)[1057461] fix [info globals ::varName] (fellows) - -2004-11-02 (bug fix)[761471] fix [expr {NaN == NaN}] (sofer) - -2004-11-02 (bug fix)[1017151] misleading errorInfo after tests (seeger,porter) - -2004-11-03 (bug fix)[527164] preserve errorinfo from var traces (porter) - -2004-11-08 (bug fix){947693] Made -blocking option of channel during [close] -consistent on Windows with Unix (gravereaux) - *** POTENTIAL INCOMPATIBILITY *** - -2004-11-11 (bug fix)[1034337] recursive file delete, MacOSX (steffen) - -2004-11-12 (new feature)[TIP 221] [interp bgerror] (porter) - -2004-11-12 (new feature)[TIP 226] Tcl_(Save|Restore|Discard)InterpState -(porter) - -2004-11-12 (new feature)[TIP 227] Tcl_(Get|Set)ReturnOptions (porter) - -2004-11-12 (bug fix)[1004065] stop crash when TCL_UTF_MAX==6 (hobbs,porter) - -2004-11-15 (bug fix)[10653678] [trace variable],[trace remove] interop (porter) - -2004-11-16 (bug fix)[1067709] crash in [fconfigure -ttycontrol] (hobbs) - -2004-11-18 (new feature) configure options --enable-man-suffix (max) - -2004-11-22 (bug fix)[1030465] Improve HAVE_TYPE_OFF64_T check (dejong) - -2004-11-22 (bug fix)[1043129] Fixed the treatment of backslashes in file -join on Windows (darley) - -2004-11-22 (bug fix)[976438] Move init.tcl search path construction to -tclInit (porter) - -2004-11-24 (bug fix)[1072654] Fixed segfault in info vars trivial -matching branch (new in 8.4.8) (porter) - -2004-11-24 (bug fix)[1001325, 1071701] Fixed readdir_r detection and usage -(dejong, kenny, porter) - -2004-11-24 (bug fix)[1071807] Fixed all uses of 'select' to use standard -macros rather than older bit-whacking style (kenny) - -2004-11-26 (bug fix)[1073524] Simplify the code to check for correctness of -strstr, strtoul and strtod on unix (fellows) - -2004-11-26 (bug fix)[1072136] Remove file normalize on tcl_findLibrary -search path uniqification added in 8.4.8 (porter) - -2004-11-30 (bug fix)[976520] Rework startup/initialization of the Tcl -library, encoding search initialization, and Tcl_FindExecutable structure. -[tclInit] no longer driven by the value of $::tcl_libPath (TCLLIBPATH). -(porter) - *** POTENTIAL INCOMPATIBILITY : makes encoding names case sensitive - on Windows, where they have been case insensitive *** - -2004-12-02 (bug fix)[1074671] Ensure tilde paths are not returned specially -by 'glob' (darley) - -Doc improvements [759545,926590,935853,1017072,1018486,1022527,1027849, - 1032243,1047928,1048005,1058446,1062647,1065732,1073334,etc.] -Test suite expansion [1036649,1001997,etc.] - ---- Released 8.5a2, December 7, 2004 - -2004-12-13 (bug fix)[1083082] encoding memory leaks (ade,porter) - -2004-12-13 (bug fix)[1082349] restored C++ extension support (porter) - -2004-12-14 (bug fix)[1081541] workaround automake-ism "$U" (porter) - -2004-12-15 (new feature) CallFrames on execution, not C, stack (sofer) - -2004-12-16 (bug fix)[1085023] [interp limit] support in [vwait], etc. (fellows) - -2004-12-29 (bug fix)[1090413] make [clock scan 0030] work (morian,kenny) - -2004-12-29 (bug fix)[1092789] make [clock scan 10000] work (porter,kenny) - -2004-12-29 (platform support)[1092952,1091967] MSVC7, gcc OPT compiles (hobbs) - -2005-01-06 (performance)[1020491] [http::mapReply] (fellows) -=> http 2.5.1 - -2005-01-09 (bug fix)[1095909] stopped use of readdir_r (english) - -2005-01-10 (enhancement)[1081595] stopped use of TCL_DBGX (english) - -2005-01-17 (bug fix)[1100542] [glob] of Windows shares (schar,darley) - -2005-01-19 (new feature)[TIP 235] C API for ensembles (fellows) - -2005-01-21 (new feature)[TIP 233] virtual time (kupries) - -2005-01-25 (bug fix)[1101670] [auto_reset] update for [namespace] (porter) -***POTENTIAL INCOMPATIBILITY*** -May cause re-[source]-ing of files that have not anticipated that before. - -2005-01-27 (new feature)[TIP 218] Tcl_Channel API update for threads (kupries) - -2005-01-27 (bug fix)[1109484] Tcl_Expr* updates for Tcl_WideInt (hobbs) - -2005-01-28 (platform support)[1021871] Solaris gcc 64-bit support (hobbs) - -2005-02-10 (bug fix)[1119369] Tcl_EvalObjEx: avoid shimmer loss of List intrep -(sofer,macdonald) - -2005-02-11 (platform support) correct gcc builds for AIX-4+, HP-UX-11 (hobbs) - -2005-02-24 (bug fix)[1119798] prevent [source $directory] (porter,mpettigr) -=> tcltest 2.2.8 - -2005-03-10 (bug fix)[1153871] bad ClientData cast (porter,victorovich) - -2005-03-15 (platform support) OpenBSD ports patch (thoyts) - -2005-03-18 (bug fix)[1115904] restore recursion limit in direct eval (porter) - -2005-03-24 (bug fix) stop conflict between Tcltest and Thread packages (porter) - -2005-03-29 (platform support) allow msys builds without cygwin (hobbs) - -2005-04-01 (internal change)[1158008] internal rep of "list" Tcl_Obj's -now uses a refcounted struct (sofer) -***POTENTIAL INCOMPATIBILITY*** -For any code that goes poking into the internals of "list" Tcl_Obj's - -2005-04-05 (performance)[1174551] Tcl_DecrRefCount of Tcl_Obj "chains" (sofer) - -2005-04-08 (performance)[1077262] better Tcl_Encoding cache lifetimes (porter) - -2005-04-10 (bug fix)[1180368] [interp invokehidden] mem leak (kenny,porter) - -2005-04-12 (performance)[1177363] startup encoding file scan (porter) - -2005-04-12 (performance)[1182459] [clock format] (kenny) - -2005-04-13 (bug fix) min buffer size dropped from 10 to 1 byte (gravereaux) - -2005-04-16 (bug fix)[1178445] fix memory waste at thread exit (vasiljevic) - -2004-04-16 (bug fix)[1084111] [array names] memory leak (ade,sofer) - -2005-04-19 (bug fix)[1185933] [clock] init clobbered global vars (ring,kenny) - -2005-04-19 (new feature) [::tcl::unsupported::EncodingDirs] - unsupported -command to set search path for encoding files (porter) - -2005-04-20 (bug fix)[1090869] Tcl_GetInt accept 0x80000000, 64-bit -(porter,singh) - -2005-04-22 (bug fix)[1187123] [string is boolean] respect EIAS (porter) - -2005-04-25 (enhancement) update to tzdata2005i (kenny) - -2005-04-25 (platform support) builds on Mac OS X 10.1 (steffen) - -2005-04-27 (new feature)[TIP 183] [open $f {... BINARY ...}] (porter) - -2005-04-29 (new feature)[TIP 176] simple index arithmetic (porter) - -2005-05-06 (platform support) x86_64 Solarix cc and Solaris 10 builds (hobbs) - -2005-05-10 (bug fix)[1198892] [expr {i**0}] error (kaitschu,markus) - -2005-05-10 (new feature)[TIP 132] floating-point conversion to string (kenny) -***POTENTIAL INCOMPATIBILITY*** -For scripts that rely on (tcl_precision==12) number formatting - -2005-05-10 (new feature)[TIP 232] math functions as commands (kenny) -***POTENTIAL INCOMPATIBILITY*** -Tcl_GetMathFuncInfo functioning is reduced; routine is now deprecated - -2005-05-13 (feature removed) TCL_NO_MATH compiler directive (porter) - -2005-05-14 (platform support) Mac OSX: configurable CoreFoundation API -(steffen) - -2005-05-14 (platform support) Mac OSX: use realpath when threadsafe (steffen) - -2005-05-17 (feature removed) Tcl_ObjType's "list", "procbody", "index", -"ensembleCommand", "localVarName", "levelReference, "boolean" are no -longer registered (porter) -***POTENTIAL INCOMPATIBILITY*** -For any callers of Tcl_GetObjType on those strings - -2005-05-20 (bug fix)[1201589] boolean literal prefix in expressions (porter) - -2005-05-24 (platform support) Darwin build support merged into unix (steffen) - -2005-05-24 (new feature)[1202209] Mac OSX: support [load] of .bundle binaries -Can support [load] from memory as well (steffen) - -2005-05-24 (new feature)[1202178] [time] returns non-integer result (steffen) - -2005-05-25 (new feature)[TIP 182] [expr {bool(...)}] (mistachkin,porter) - -2005-05-30 (new feature)[TIP 229] [namespace path] (fellows) - -2005-05-31 (bug fix)[1082283] Unix: notifier thread now joinable (vasiljevic) - -2005-06-01 (new feature)[TIP 241] -nocase: lsort, lsearch, switch (mistachkin) - -2005-06-01 (bug fix)[1209759] "return TCL_RETURN;" could cause panic (porter) - -Documentation improvements [1075433,1085127,1117017,1124160,1149605,etc.] - ---- Released 8.5a3, June 4, 2005 - -2005-06-06 (bug fix)[1213678] Windows/gcc: crash in stack.test (kenny) - -2005-06-07 (new feature)[TIP 208] [chan] and [chan truncate] (fellows) - -2005-06-07 (revert) Restored registration of "procbody" Tcl_ObjType (porter) -Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17. - -2005-06-13 (bug fix)[1217375,1219176] [file mkdir] race (diekhans,darley) - -2005-06-14 (bug fix)[1220058] [namespace delete] crash (duquette,fellows) - -2005-06-17 (bug fix)[1221395] Tcl_LimitSetTime able to break [vwait] (fellows) - -2005-06-18 (bug fix)[1154163] [format %h] on 64-bit OS's (kraft,fellows) - -2005-06-21 (bug fix)[1201035,1224585] execution trace crashes (porter) - -2005-06-21 (bug fix)[1194458] Windows: [file split] (kenny,porter) - -2005-06-22 (bug fix)[1225727] Windows: pipe finalization crash (kenny) - -2005-06-22 (bug fix)[1225571] Windows: [file pathtype] buffer overflow (thoyts) - -2005-06-22 (bug fix)[1225044] Windows: UMR in pipe close (kenny) - -2005-06-23 (bug fix)[1225957] Windows/gcc: crashes in assembler code (kenny) - -2005-06-24 (bug fix) make Tcl_Preserve safe in Tk exit handlers (kenny) - -2005-07-01 (bug fix)[1222872] notifier spurious wake-up protection (vasiljevic) - -2005-07-05 (bug fix)[1230597] allow idempotent [namespace import] (porter) - -2005-07-15 (bug fix)[1237907] localtime() => NULL => crash (kenny) - -2005-07-21 (dropped support) IRIX 4, RISCos, Ultrix, and ancient BSD (kenny) -***POTENTIAL INCOMPATIBILITY*** - -2005-07-22 (enhancement)[1237755] 8.4 features in script library (fradin,porter) - -2005-07-24 (new feature) configure macros SC_PROG_TCLSH, SC_BUILD_TCLSH (dejong) -2005-07-26 (bug fix)[1047286] cmd delete traces during namespace delete (porter) - -2005-07-26 (new unix feature)[1231015] ${prefix}/share on ::tcl_pkgPath (dejong) -***POTENTIAL INCOMPATIBILITY*** - -2005-07-27 (bug fix)[1214462] [unknown] can return exceptions (porter) - -2005-07-27 (new feature) value of ::tcl_precision now kept per-thread (porter) -***POTENTIAL INCOMPATIBILITY*** - -2005-07-28 (unix bug fix)[1245953] O_APPEND for >> redirection (fellows) - -2005-07-29 (bug fix)[1247135] [info globals] return only existing vars (fellows) - -2005-07-30 (new Darwin feature) TCL_LOAD_FROM_MEMORY configuration (steffen) - -2005-08-05 (bug fix)[1241572] correct [expr abs($LONG_MIN)] (kenny) - -2005-08-05 (Solaris bug fix)[1252475] recognize cp1251 encoding (wagner,fellows) - -2005-08-11 (config options) eliminated USE_THREAD_STORAGE option (kenny) - -2005-08-23 (toolchain support) autoconf-2.59 now required (dejong) - -2005-08-24 (new feature)[TIP 219] reflected channels ([chan create]) (kupries) - -2005-08-25 (bug fix)[1267380] [lrepeat] buffer overflow prevention (fellows) - -2005-08-26 (bug fix) fix [namespace ensemble] crashes in Snit (fellows) - -2005-08-29 (bug fix)[1275043] restore round() away from zero (kenny) - -2005-08-29 (bug fix)[1189657] correct [tcl::tm::roots] (porter) - -2005-09-07 (bug fix)[1283976] invalid [format %c -1] result (porter) - -2005-09-08 (new feature)[1242844][TIP 254] new types for Tcl_LinkVar (fellows) - -2005-09-07 (toolchain support) deprecate TCL_VARARGS*; stdarg.h assumed (porter) -***POTENTIAL INCOMPATIBILITY*** - -2005-09-15 (RHEL bug fix)[1287638] support open >2GB files RHEL 3 (palan) - -2005-09-08 (new feature)[TIP 255] [expr min()] and [expr max()] (hobbs) - -2005-09-30 (bug fix)[1306162] $argv encoding and list formatting (porter) - -2005-10-04 (bug fix)[1067708] [fconfigure -ttycontrol] leak (hobbs) - -2005-10-04 (bug fix)[1182373] [http::mapReply] update to RFC 3986 (aho,hobbs) -=> http 2.5.2 - -2005-10-04 (HPUX bug fix)[1204237] shl_load() and DYNAMIC_PATH (collins,hobbs) - -2005-10-05 (bug fix)[979640] buffer overrun mixing putenv(), ::env (bold,hobbs) - -2005-10-08 (new feature)[TIP 237] unlimited range for integers (kenny,porter) -***POTENTIAL INCOMPATIBILITY*** for any code that relies on implicit truncation -of integer calculations to the range of a C long - -2005-10-14 (platform support)[1256937] MSVC++ static builds (thoyts) - -2005-10-19 (bug fix)[1331475] [dict append] crash (bills,sofer) - -2005-10-20 (bug fix)[1333036] [lset] shared sublist handling (sofer) - -2005-10-23 (bug fix)[1335006] memleack in [glob] (melbardis,darley) - -2005-10-23 (bug fix)[1325803] Win: [file stat] on links (bonilla,darley) - -2005-11-01 (bug fix)[1337941] Tcl_TraceCommand() -> crash (devilliers,porter) - -2005-11-02 (platform support)[1256937] MSVC 8 support (thoyts) - -2005-11-03 (new Win NT/XP feature) Unicode console support (kovalenko,thoyts) - -2005-11-04 (bug fix)[1337229,1338280] [namespace delete] / unset traces (sofer) - -2005-11-04 (enhancement) Korean timezone abbreviations (kenny) - -2005-11-04 (platform support)[1163896] LynxOS [load] (heidibr) - -2005-11-04 (bug fix)[1334947] value refcount error in var setting (sofer) - -2005-11-04 (Win enhancement)[1267871] extended exit codes (newman,thoyts) - -2005-11-07 (bug fix)[1348775] unset trace memory leak (sofer) - -2005-11-08 (bug fix)[1162286] [package require] checks that the script -registered by [package ifneeded] provides the version it claims (lavana,porter) -*** POTENTIAL INCOMPATIBILITY *** - -2005-11-09 (bug fix)[1350293,1350291] [after $negative $script] fixed (kenny) - -2005-11-12 (bug fix)[1352734,1354540,1355942,1355342] [namespace delete] -issues with [namespace path] and command delete traces (sofer,fellows) - -2005-11-18 (bug fix)[1358369] URL parsing standards compliance (wu,fellows) -=> http 2.5.2 - -2005-11-18 (revert) Restored registration of "list" Tcl_ObjType (porter) -Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17. - -2005-11-18 (bug fix)[1359094] Tclkit crash (thoyts, kupries) - -2005-11-20 (bug fix)[1091431] Tcl_InitStubs failure crashes wish (english) - -2005-11-27 (platform support) Darwin 64bit, Tiger copyfile(), and -Max OSX universal binaries support (steffen) - -2005-11-28 (bug fix) [clock] DST transition error (mackerras,kenny) - -2005-11-29 (bug fix)[1366683] [lsearch -regexp] backrefs (cleverly,fellows) - -2005-11-30 (performance) recoded portions of [clock] in C (kenny) - -2005-11-30 (enhancement) improved bytecode compiling of [switch] (fellows) -*** POTENTIAL INCOMPATIBILITY *** -For loading bytecode compiled and saved by earlier 8.5alpha releases - -2005-12-05 (Darwin bug fix)[1034337] NFS recursive file delete (steffen) - -2005-12-08 (platform support) Win x64 build (hobbs) - -2005-12-09 (bug fix)[1374778] [lsearch -start $pastEnd] => -1 (fellows) - -2005-12-12 (bug fix)[1377619] configure syntax error exposed in bash-3.1 (hobbs) - -2005-12-13 (bug fix)[1379349] [dict for] CoW error (ring,hippler,fellows) - -2005-12-18 (bug fix)[1382528] [dict for {k v} {} {}] crash (kovalenko,fellows) - -2005-12-27 clock tzdata updated to Olson's tzdata2005r (kenny) - -2005-12-27 libtommath updated to release 0.37 (kenny) - -2006-01-09 (bug fix)[1480572] [info level $l] => "namespace inscope" (porter) - -2006-01-11 (compat support)[1397843] when ::errorInfo is traced, fall back to -old pattern of stack trace construction (porter). -Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2004-10-05. - -2006-01-12 (bug fix)[1366227] Win: [file stat] sharing violation (darley) - -2006-01-23 (bug fix)[1410553] Tcl_GetRange Unicode confusion (twylite,spjuth) - -2006-01-23 (bug fix)[1412695] args handling in precompiled procs (traum,sofer) - -2006-02-01 (new feature)[1275435][TIP 250] [namespace upvar] (sofer) - -2006-02-01 (new feature)[958222][TIP 181] [namespace unknown] (madden) - -2006-02-01 (new feature)[944803][TIP 194] [apply] (mistachkin) - -2006-02-08 (new feature)[1413934][TIP 258] [encoding dirs], etc. (porter) - -2006-02-09 (new feature)[1413115][TIP 215] auto-init [incr] (leitgeb) - -2006-03-02 (bug fix)[1379287] norm of paths with /../ back to root (porter) - -2006-03-03 (compat support) Restored registration of a "boolean" Tcl_ObjType -(porter) -Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17. - -2006-03-06 (bug fix)[1439836,1444291] fix TCL_EVAL_{GLOBAL,INVOKE} handling -when auto-loading or exec traces are present (porter) - -2006-03-10 (bug fix)[1437595] Win socket finalize with threads (vasiljevic) - -2006-03-13 (revert 2005-07-26 change) ${prefix}/share on ::tcl_pkgPath (porter) - -2006-03-14 (bug fix)[1448251] TCLX.y_TM_PATH handling (noble, kupries) - -2006-03-14 (bug fix)[768659] pipeline error when last command missing (kupries) - -2006-03-18 (bug fix)[1193497] Win porting of [file writable] (darley,vogel) - -2006-03-18 (bug fix)[1084705] [glob -nocomplain] silence empty result only, -no other errors (darley) -***POTENTIAL INCOMPATIBILITY*** - -2006-03-21 (platform enhancement)[823329] HFS globbing support (steffen) - -2006-03-23 (platform support) updated tcl.spec file (max) - -2006-03-28 (bug fix)[1064247] BSD: path normalization with realpath() (steffen) - -2006-04-03 (bug fix)[1462248] crash reading utf-8 chars spanning multiple -buffers at end of file (kraft,kupries) - -2006-04-05 (bug fix)[1464039] Tcl_GetIndexFromObj: empty key (fellows) - -2006-04-05 (bug fix) overdue dde, registry patchelevel increments (porter) -=> dde 1.3.2 -=> registry 1.2 - -2006-04-06 (bug fix)[1457515] TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING -removed (steffen) - -2006-04-11 (bug fix)[1458266] enter/enterstep trace interference (leunissen) - -2006-04-12 (feature change)[1376892] revised definition of [:print:] (fellows) - -(platform support) Use of _ANSI_ARGS_ purged. ANSI compiler required (fellows) - -Documentation improvements [1211078,1190891,1292427,1277503,1104682,1359183, -1415725,666770] - ---- Released 8.5a4, April 27, 2006 - -2006-05-04 (bug fix)[1480509] srand() accept wide input (porter,afredd) - -2006-05-05 (bug fix)[1481986] interactive Tcl_Main blocks main loop (porter,lin) - -2006-05-13 (bug fix)[1482718] proc re-compile: preserve the previous -bytecode while references still on the stack (porter,ryazanov) - -2006-05-27 (bug fix)[923072] Darwin: made unthreaded CoreFoundation notifier -naked-fork safe on Tiger (steffen) - -2006-06-20 (internal change) Dropped the internal routines used to hook into -filesystem operations back in the pre-Tcl_Filesystem days. (porter) -***POTENTIAL INCOMPATIBILITY*** -For extensions and programs that have never migrated to the supported Tcl 8.4 -interface for virtual filesystems - -2006-07-05 (enhancement) Expression parser rewrite avoids stack overflow, -reduces from O(N^2) to O(N) complexity, and greatly improves syntas error -messages (porter) -***POTENTIAL INCOMPATIBILITY*** -For any code relying on exact error messages. - -2006-07-20 (platform support) Mac OS X weak linking (steffen) - -2006-07-20 (bug fix) Darwin: execve() works iff event loop not yet run (steffen) - -2006-07-24 (bug fix)[1518166] Uninitialized Tcl_DString (afredd) - -2006-07-30 (bug fix)[1426279,1505383,1494664,1531530] [clock] fixes (kenny) - -2006-08-09 (bug fix)[1531184] [dict for {file stat} x {}] crash (fellows) - -2006-08-10 (bug fix)[1538262,1530474] code cleanup; optimizations (afredd) - -2006-08-18 (bug fix) intermittent failures in TclUnixWaitForFile() (steffen) - -2006-08-18 (platform support) Darwin x86_64 (steffen) - -2006-08-21 (bug fix)[1457797] Darwin 64-bit notifier hang (steffen) - -2006-08-21 (bug fix) Darwin: recursively called event loop (steffen) - -2006-08-21 (enhancement) Darwin: nanosec resolution clicks and [time] (steffen) - -2006-08-28 (bug fix)[1547681] TclFormatObj count arguments (mistachkin,porter) - -2006-08-28 (bug fix) stack.test failure on FreeBSD (mistachkin) - -2006-08-30 (bug fix)[1548263] filesystem segfaults (hobbs,mccormack) - -2006-08-31 (bug fix)[1541274] [expr {sqrt(-1)}] => -NaN (suchenwirth,porter) - -2006-09-06 (bug fix)[999544] use of MT-safe system calls (vasiljevic) - -2006-09-10 (platform support) Darwin: msgcat use CFLocale (steffen) -=> msgcat 1.4.2 - -2006-09-10 (new feature) tcltest option: -verbose line (steffen) -=> tcltest 2.3a1 - -2006-09-19 (bug fix)[1555271,1561260] Several ** operator bugs (porter) - -2006-09-22 (bug fix)[1562528] NULL terminates variadic calls (fellows,ryazanov) - -2006-09-22 (new feature)[1520767][TIP 268] [package] alpha/beta version; -[package require] ranges, [package prefer] selection mode (kupries) - -2006-09-26 (platform support) MSVC8 AMD64 support (thoyts) - -2006-09-27 (bug fix)[1567222] bignum << errors (porter) - -2006-09-30 (enhancement)[1190441] quiet no-op [history] (sofer) - -2006-10-04 clock tzdata updated to Olson's tzdata2006m (kenny) - -2006-10-05 (bug fix)[1570718] make [lappend $nonList] complain (sofer,virden) - -2006-10-05 (bug fix)[1122671] alignment fixes in unicode encoding routines -(hobbs,staplin) - -2006-10-05 (enhancement) Allow "_" in Tcl Module filenames (kupries) - -2006-10-05 (new feature) [set ::http::strict 0] (default value is 1) to disable -URL validity checking against RFC 2986 (hobbs) -=> http 2.5.3 - -2006-10-06 (new feature)[1565751][TIP 275] [binary scan] unsigned (thoyts) - -2006-10-10 (bug fix)[1566526] crash cleaning up [namespace path] data (porter) - -2006-10-12 (bug fix)[1576006] better error messages from [interp alias] (sofer) - -2006-10-13 (platform support) get stack size on Darwin (steffen) - ---- Released 8.5a5, October 20, 2006 - -2006-10-20 (configure change) Added autodetection for OS-supplied timezone -files (max) - -2006-10-23 (enhancement)[1577278] Ensure the Tcl call stack always has a -CallFrame, even at level 0 (sofer) - *** POTENTIAL INCOMPATIBILITY for users of tclInt.h *** - -2006-10-23 (enhancement)[1577492] Tcl_PushCallFrame and [info level] -enhanced for ensemble rewrites (sofer) - *** POTENTIAL INCOMPATIBILITY for [info level 0] on interp alias *** - -2006-11-02 (feature change)[TIP 293] Replace {expand} with {*} (hobbs) - *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only *** - -2006-11-04 (new feature)[TIP 274] Exponentiation operator is right -associative (porter) - -2006-11-09 (new feature)[TIP 272] Added [lreverse] and [string reverse] -commands (fellows) - -2006-11-14 (new feature)[TIP 261] [namespace import] returns list of -imported commands (porter) - -2006-11-15 (new feature)[TIP 270] New C routines Tcl_ObjPrintf, -Tcl_AppendObjToErrorInfo, Tcl_Format, Tcl_AppendLimitedToObj, -Tcl_AppendFormatToObj, Tcl_AppendPrintfToObj (porter) - -2006-11-22 (feature change) Moved TCL_REG_BOSONLY from tcl.h to tclInt (porter) - -2006-11-22 (new feature)[TIP 269] Added [string is list] classification -command (mistackin, fellows) - -2006-11-25 (new feature)[TIP 174] Added commands corresponding to most -expr operators in ::tcl::mathop (fellows) - -2006-11-26 (platform support)[1230558] --enable-64bit on more systems (steffen) - -2006-11-27 (bug fix)[1602208] Fix 64-bit handling of select() on unix where -fd was greater than 32 (fontaine, kenny) - -2006-11-28 (new feature)[TIP 280] Added [info frame] command for more -Tcl-level debugging information (kupries) - -2006-12-01 (feature change)[TIP 298] Change Tcl_GetBignumAndClearObj to -Tcl_TakeBignumFromObj (porter) - -2006-12-01 (new feature)[TIP 287] Added [chan pending] subcommand (cleverly) - -2006-12-01 (new feature)[TIP 299] Added isqrt() expr operator (kenny) - -2006-12-04 (new feature)[TIP 267] Added -ignorestderr option to exec (fellows) - -2006-12-05 (new feature)[TIP 291] ::tcl_platform(pointerSize) key (kupries) - -2007-01-11 (configure change) Remove "-Wconversion" from deflt CFLAGS (english) - -2007-01-25 (configure change) Ensure CPPFLAGS env var is used when set (steffen) - -2007-02-19 (configure change) Use SHLIB_SUFFIX=".so" on HP-UX IA64 (was -".sl") (hobbs) - -2007-02-20 (bug fix)[1479814] Handle Windows NT \\?\... extended paths (thoyts) - -2007-03-01 (bug fix)[1671138] Fix infinite loop in compiled foreach with an -empty list (fellows) - -2007-03-07 (enhancement) Improved Windows time zone tables to handle new US -DST rules (kenny) - -2007-03-09 (enhancement) Improved Y2038 compliance of zoneinfo files (kenny) - -2007-04-02 (enhancement) Added bytecode compilation for global, variable, -upvar and namespace upvar (sofer) - -2007-04-20 (bug fix) Improve clock localization for Japanese locale (kenny) - -2007-04-20 (enhancement) Document Tcl_SetNotifier & Tcl_ServiceModeHook (kenny) - -2007-04-23 (bug fix) fts_open() crash on 64bit Darwin 8 or earlier (steffen) - ---- Released 8.5a6, April 25, 2007 - -2007-04-30 (bug fix)[1705778] many valgrind-detected leaks corrected - -2007-05-01 (bug fix)[1710709] leak in [string map] (porter) - -2007-05-02 (bug fix)[1710707] leaks in filesystem paths (mistachkin,kenny) - -2007-05-18 (feature change) {expand} syntax support removed. (porter) - *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only *** - -2007-05-29 (bug fix)[1712723] Joinable thread death on 64-bit (virden,hobbs) - -2007-05-30 (feature change)[1725186] When expanded literals are parsed, -(example: {*}{1 2 3}), TCL_TOKEN_EXPAND_WORD token is no longer returned. -Tokens reflecting the expansion are returned instead. (porter) - *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only *** - -2007-06-06 (platform support) Darwin: add plist to tclsh (steffen) - -2007-06-12 (enhancement) [info] is now a [namespace ensemble] (fellows) - -2007-06-20 (enhancement) better `make html` results (hobbs) - -2007-06-21 (feature change)[1740962] leave traces created during execution -of traced command do not fire (sofer) - *** POTENTIAL INCOMPATIBILITY *** - -2007-06-23 (bug fix) Darwin: prevent post-fork() abort() (steffen) - -2007-06-27 (bug fix)[1743941] Infinite loop in Tcl_CreateTrace traces (porter) - -2007-06-29 (enhancement) Tcl_Alloc alignment on Darwin (steffen) - -2007-06-30 (bug fix)[1726873] crash in thread sync objects (vasiljevic,twylite) - -2007-06-30 (bug fix)[1717186] [lsort -command \{ $l] leak (afredd,fellows) - -2007-07-05 (bug fix)[1743676] no command named "" error message (porter,virden) - -2007-07-11 (bug fix)[1752146] [while 1 {}] & [interp limit] on commands (sofer) - -2007-07-31 (bug fix)[681877] tcl_platform(user) from system, not env (fellows) - -2007-07-31 (enhancement)[1750051] space efficiency of Tcl variables (sofer) - *** POTENTIAL INCOMPATIBILITY for C code that accesses internal - Tcl structs Var, Bytecode, Namespace, or CallFrame. *** - -2007-08-01 (enhancement)[1764318] word.tcl proc rewrites (petasis,fellows) - -2007-08-08 (bug fix)[1770224] [tcl::mathop::>> $big1 $big2] errors (porter) - -2007-08-14 (platform support) Darwin [load] from VFS on intel & 64bit (steffen) - -2007-08-15 (bug fix)[1773127] corrected open mode "a+" (rottman,fellows) - -2007-08-16 (bug fix)[1773040] ::errorInfo trace crash (janssen,porter) - -2007-08-16 (performance)[1564517] precompile constant expressions (porter) - -2007-08-21 (bug fix)[1775878] 'puts \' in interactive tclsh failed to move to -prompt for continuation line (porter) - -2007-08-25 (bug fix)[1781282] [clock scan] case senstivity (kenny) - -2007-08-25 (performance)[1767293] ** on native integer types (kenny) - -2007-09-03 clock tzdata updated to Olson's tzdata2007g (kenny) - -2007-09-06 (platform support) Darwin: drop support for Xcode 1.5 project, add -project for Xcode 3.0 (steffen) - -2007-09-08 (bug fix)[1786481] nested [dict update] crash (fellows) - -2007-09-08 (bug fix)[1710710] TclPtrSetVar leak (mistachkin,sofer) - -2005-09-09 (feature removed) Tcl_ObjType "nsName" no longer registered (porter) - *** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("nsName") *** - -2007-09-10 (bug fix)[1740631] Linked variable unlink prevention (maros,hobbs) - -2007-09-11 (bug fix)[1786481] [dict update] stack management (sofer) - *** POTENTIAL INCOMPATIBILITY with previous 8.5 alpha bytecode only *** - -2007-09-11 (bug fix)[1578344] [package require -exact] 8.4 compat (porter) - *** POTENTIAL INCOMPATIBILITY with previous 8.5 alphas only *** - -2007-09-11 (bug fix)[1772989,1071322] Support _, : in test constraints (porter) -=> tcltest 2.3b1 - -2007-09-11 (platform support) Windows AMD64 support (thoyts) - -2007-09-14 (enhancement)[1793984] DTrace provider for Tcl (steffen) - -2007-09-14 (bug fix)[1519940] surplus ns path invalidation (fellows,bauer) - -2007-09-15 (platform support) SunOS-5.1x link with cc, not ld (steffen) - -2007-09-17 (platform support)[1748251] Fix NetBSD link failures (english) - -(bug fix)[1066755] Several stack efficiency efforts increases recursion limit -on Windows to be larger than the default [interp recursionlimit] value - ---- Released 8.5b1, September 26, 2007 - -2007-10-02 (bug fix)[1806422] proper [tcl::tm::path] autoload (porter) - -2007-10-02 (bug fix) Improve Tcl_DecrRefCount() robustness (staplin) - -2007-10-11 (bug fix)[1805887] [string is int -failindex] for 0o, 0b (porter) - -2007-10-15 (bug fix)[1813528] Tcl_ParseBraces read past buffer (mistachkin) - -2007-10-25 (bug fix)[1726873] intermittent crash in threads (vasiljevic) - ---- Released 8.5b2, October 26, 2007 - -2007-10-27 (bug fix)[1821159] fixed broken compile on x86_64 (sofer) - -2007-10-27 (bug fix)[1810264] stop panic in RE lexer (fellows) - -2007-10-28 (enhancement)[1826906] Embed iso8859-1 encoding in libtcl (fellows) - -2007-11-01 (bug fix)[1808258] [string is ascii \000] (fellows) - -2007-11-05 (bug fix)[1823576] [fconfigure $serial -xchar \000] (cassof) - -2007-11-07 (performance)[1827996] binary glob matching (hobbs) - -2007-11-07 (performance) binary [gets] (hobbs) - -2007-11-09 (performance)[1829248] interp state reset (sofer) - -2007-11-10 (performance) stack checking (sofer) - -2007-11-10 (performance) list indexing bytecode (sofer) - -2007-11-11 (performance)[1830038] macros to fetch Tcl_Obj intreps (sofer) - -2007-11-11 (performance)[1830166] RE bytecode for simple cases (hobbs) - -2007-11-13 (performance) [switch] & [regexp] use RE bytecode (hobbs, fellows) - -2007-11-14 (performance) bytecode for [info exists] (fellows) - -2007-11-15 (new feature)[1231022] configure option: --disable-rpath (fellows) - -2007-11-15 (bug fix)[1810038] infinite loop in RE compiler (lane,porter) - -Many significant documentation improvements (fellows, sofer) - ---- Released 8.5b3, November 19, 2007 - -2007-11-20 (enhancement) string rep of dict has stable order (fellows) - -2007-11-21 (enhancement) compiled ensemble support (fellows) - -2007-11-22 (enhancement) [dict] is now an ensemble (fellows) - -2007-11-23 (enhancement) [string] is now an ensemble (fellows) - -2007-11-26 (bug fix)[1815573] Correct stack checking failure (sofer,golovan) - -2007-11-27 (bug fix)[800753] Document single byte char limit for -[chan configure -eofchar] (cassoff) - -2007-12-03 (enhancement)[1836519] [switch $val $body] safe/fast (fellows,spjuth) - -2007-12-03 (release) tcltest package bump to 2.3.0 (porter) - -2007-12-03 (bug fix)[1618235] fix BSD compile errors (fellows) - -2007-12-05 (bug fix)[1844789] fix [lsearch -exact -integer] crash (fellows) - -2007-12-05 (performance)[1845092] Tcl_ObjType for channel names (hobbs) - -2007-12-14 (bug fix)[1602539] NUL pollution in [glob] result (hobbs) - -2007-12-17 (bug fix)[1851832,1851524] memory alignment correction (sofer) - -2007-12-18 (bug fix)[1810264] revised regexp engine to prevent debilitating -over-consumption of resources (drewry,lane,ormandy,fellows) - -Several documentation and release notes improvements - ---- Released 8.5.0, December 20, 2007 - -2007-12-23 (bug fix)[1857126] restore backref support to regexps (hobbs) - -2007-12-26 (enhancement)[1856994] [lsort] performance (sofer) - -2008-01-10 (bug fix)[1867855] fix [format %lli 0] crash (porter) - -2008-01-11 (bug fix)[1850424,1860425] stack checking on *bsd (sofer,noble) - -2008-01-13 (bug fix)[1353846] crash in read-only serial (hobbs,newman) - -2008-01-15 (bug fix)[1869989] mem leak; expr literals (porter,melbardis) - -2008-01-20 (bug fix)[1869405] binary [gets]; stacked channels (hobbs,ficicchia) - -2008-01-22 (bug fix)[1867855] fix [lreverse {}] crash (sofer,madden) - -2008-01-30 (bug fix)[1882373] fix Tcl_GetAlias pointer code (an00na) - -Several documentation and release notes improvements - ---- Released 8.5.1, February 5, 2008 - -2008-02-06 (enhancement) [clock format] performance (kenny) - -2008-02-12 (bug fix)[1891827] compiled [switch -nocase] error (fellows) - -2008-02-22 (bug fix)[1818565] missing state array in http::status (thoyts) -=> http 2.5.4 - -2008-02-26 (bug fix)[1868845] corrected [eof] ordering (thoyts) - -2008-02-26 (new feature) [http::meta] command (thoyts) -=> http 2.5.5 - -2008-02-26 (bug fix)[1902436] fixed regexps ending in \* (hobbs) - -2008-02-27 (bug fix)[1862555,1902423] [clock] range & l10n (kenny) - -2008-02-28 (bug fix) [return -level 0] memory leak (porter) - -2008-02-28 (bug fix) [format %llx $big] memory leak (porter) - -2008-02-28 (bug fix) expression parser error message memory leak (porter) - -2008-02-28 (bug fix) memory leak when enter trace modifies command (porter) - -2008-02-29 (enhancement) Consumer refcounting for Tcl_SetReturnOptions() -and Tcl_AddObjToErrorInfo() (spjuth,porter) - *** POTENTIAL INCOMPATIBILITY *** - -2008-03-07 (bug fix)[1899164] Avoid expr and script bytecode confusion (porter) - -2008-03-07 (bug fix)[1904907] finalize crash in Tcl_GetReturnOptions (kupries) - -2008-03-10 (bug fix)[1893815] expr {abs(-1e-350)} => -0.0 (porter) - -2008-03-10 (bug fix)[1901113] crash in [tcl::Bgerror {} {}] (madden,porter) - -2008-03-11 (bug fix)[1911919] unset trace inf loop in namespace delete (sofer) - -2008-03-12 (new feature) some HTTP 1.1 support in http (and more!) (hobbs) -=> http 2.7 - -2008-03-13 (enhancement) support space in INSTALL_ROOT or $builddir (steffen) - -2008-03-16 (bug fix)[1903325] bytecode stack space prediction crash (fellows) - -2008-03-18 (bug fix)[1914604] Tcl Modules: encoding fixed to utf-8; environment -variables without "." added to customization hooks (kupries) - *** POTENTIAL INCOMPATIBILITY *** - -2008-03-18 (bug fix)[1914503] alignment of TclStackAlloc() return (sofer)\ - -2008-03-20 (bug fix)[1868171] expose Tcl_GetMemoryInfo (for AOLserver) (fellows) - -2008-03-24 (bug fix)[1923966] crash in [binary format x0s] (thoyts) - -2008-03-27 (platform support)[1921166] Solaris 64bit build fixes (steffen) - -2008-03-27 clock tzdata updated to Olson's tzdata2008b (kenny) - ---- Released 8.5.2, March 28, 2008 - -2008-03-30 (bug fix)[1783544] more robust TclIsNaN() (kenny,teterin) - -2008-04-01 (interface)[1819422] tclStubsPtr no longer in libtcl (porter) - *** POTENTIAL INCOMPATIBILITY *** - -2008-04-01 (bug fix)[1839067] FP round fix for Solaris/x86 (kupries,schlenker) - -2008-04-02 (bug fix)[780533,1932639] [fcopy] callbacks unreliable (ferrieux) - -2008-04-02 (interface)[1819422] libtclstub symbols MODULE_SCOPE (steffen) - -2008-04-04 (bug fix) [chan postevent] crash (kupries) - -2008-04-07 (bug fix) Fix broken [format {% d}] (max) - -2008-04-07 (bug fix)[1350564] Bi-directional [fcopy] now supported (ferrieux) - -2008-04-16 (bug fix)[1938497] Tcl_SetNotifier() fixes (steffen) - -2008-04-16 (interface)[1938497] make stubs tables 'static const' (steffen) - -2008-05-02 (new feature) [binary] is now a [namespace ensemble] (thoyts) - -2008-05-07 (bug fix) [dict append] crash (mccormack,fellows) - -2008-05-21 (bug fix)[1968882] [info complete "\\\n"] => 0 (porter) - -2008-05-22 (bug fix)[1968245] Tcl_LogCommandInfo() accept length=-1 (darroch) - -2008-05-23 (bug fix)[1965787] 32-bit overflow in [tell] result (ferrieux) - -2008-05-31 (new feature)[TIP 257] [oo::*] commands from TclOO (fellows) - -2008-06-04 (new feature)[TIP 317] [binary encode]; [binary decode] (thoyts) - -2008-06-06 (new feature)[TIP 230] [chan push]; [chan pop] (kupries) - -2008-06-08 (enhancement)[1973096] bytecompiled [uplevel] scripts (sofer) - -2008-06-12 (platform support) Solaris static build with DTrace (steffen) - -2008-06-12 (platform support) Solaris/amd64 gcc 64bit support (steffen) - -2008-06-13 (new feature)[TIP 285] [interp cancel]; Tcl_CancelEval() (mistachkin) - -2008-06-20 (bug fix)[1999035] make [interp bgerror $i] act in $i (porter) - -2008-06-23 (bug fix)[1972879] bad path intrep caching (porter) - -2008-06-24 (bug fix)[1999176] crash in [glob -dir {} a] (porter) - -2008-06-25 (bug fix)[1999119] Support TM packages in Safe Base (kupries) - ---- Released 8.6a1, June 25, 2008 - -2008-06-29 (bug fix)[2004480] plug memory leaks (ade,porter,steffen) - -2008-07-01 (enhancement)[1905562] embed recursion limit in RE engine (fellows) - -2008-07-03 (bug fix)[1969717] fix package finding on Samba shares (jos) - -2008-07-03 (bug fix)[1987821] mem leak in [seek] on reflected chan (kupries) - -2008-07-13 (enhancement)[2017110] new Non-Recursive Evaluation implementation -enables deep Tcl evaluation stacks without deep C stacks. (sofer) - -2008-07-20 (enhancement)[2008248] dict->list preserve item intreps (pasadyn) - -2008-07-21 (bug fix)[582506] imported cmds now fire execution traces (sofer) - -2008-07-21 (bug fix)[2015723] [file] bad use of inodes on Windows (thoyts) - -2008-07-21 (new feature)[TIP 304] [chan pipe] (ferrieux) - -2008-07-21 (bug fix)[2021443] more consistent "wrong # args" msgs (nijtmans) - -2008-07-21 (enhancement) [info frame] returns file data in more cases (kupries) - -2008-07-29 (bug fix)[2030670] fix rare panic in TclStackFree (pasadyn,sofer) - -2008-08-01 Tcl_Finalize() no longer called implicitly on DLL_PROCESS_DETACH. - -2008-08-05 (enhancement)[1994512] async connect logic simplified (jenglish) - -2008-08-06 (bug fix)[2040295] stopped supplying a workaround for bugs -in Itcl's use of [namespace code]. Itcl now supplies its own workaround. - *** POTENTIAL INCOMPATIBILITY for older Itcl releases *** - -2008-08-06 (bug fix)[2039178] repaired guard against dispatching oo methods -in a deleted interp. (porter) - -2008-08-08 tzdata updated to Olson's tzdata2008e (kenny) - -2008-08-11 (bug fix)[2046846] 64bit support for http zlib crc (thoyts) -=> http 2.7.1 - -2008-08-11 (enhancement) automatic [package provide] for TMs (kupries) - -2008-08-17 (bug fix)[2055782] crash involving Tcl_ConcatObj (sofer) - -2008-08-21 (new feature) CONST-ified Tcl routines passing (Tcl_ObjType *), -(Tcl_Filesystem *), or (Tcl_Timer *) arguments (nijtmans,porter) - *** POTENTIAL INCOMPATIBILITY *** - -2008-08-21 (bug fix)[2065115] Restored ***= regexp functioning (hobbs,porter) - ---- Released 8.6a2, August 25, 2008 - -2008-08-29 (bug fix)[2082299] Install TclOO header files (fellows) - -2008-09-01 oo methods called during interp deletion no longer skipped if -they do not need the dying interp (fellows) - -2008-09-02 (support) Dropped support for pre-ANSI compilers. (porter) - -2008-09-04 (bug fix)[2093947] var unset trace in coroutine (fellows,sofer) - -2008-09-10 (enhancement) efficient list->dict conversion (elby,fellows) - -2008-09-10 (bug fix)[2102930] faulty numLevels count (madden,sofer) - -2008-09-16 (bug fix)[2114165] eval failure following cancel (sofer) - -2008-09-17 (bug fix)[2116053] export [min] and [max] from tcl::mathfunc (sofer) - -2008-09-22 (new feature)[TIP 320] oo common variable declaration (fellows) - -2008-09-24 (new feature)[TIP 316] portable access to Tcl_StatBuf (fellows) - -2008-09-24 (new feature)[TIP 323] [file delete], [file mkdir] zero pathNames (porter) - -2008-09-25 (new feature)[TIP 315] new var: tcl_platform(pathSeparator) (vu,fellows) - -2008-09-25 (new feature)[TIP 323] [global], [variable] zero varNames (porter) - -2008-09-26 (new feature)[TIP 323] [lassign], [namespace upvar], [my variable] zero varNames (porter) - -2008-09-26 (new feature)[TIP 323] [tcl::tm::path add|remove] zero pathNames (porter) - -2008-09-26 (new feature)[TIP 323] [lrepeat] zero elements; zero repeats (porter) - -2008-09-27 (bug fix)[2130992] prevent overflow crash in [lrepeat] (fellows) - -2008-09-28 (new feature)[TIP 314] ensemble parameters before subcommand (hellström,fellows) - -2008-09-29 (new feature)[TIP 318] revised defaults for [string trim] (poser) - *** POTENTIAL INCOMPATIBILITY *** - -2008-09-29 (new feature)[TIP 313] [lsearch -bisect] (spjuth) - -2008-09-29 (new feature)[TIP 326] [lsort -stride] (elby) - -2008-09-29 (new feature)[TIP 323] [linsert] zero elements (porter) - -2008-09-29 (new feature)[TIP 323] [glob] zero patterns (porter) - -2008-10-02 (new feature)[TIP 330] interp->result access disabled (kenny) - *** POTENTIAL INCOMPATIBILITY *** - -2008-10-03 (new feature)[TIP 265] Tcl_ParseArgv() (bromley) - -2008-10-03 (new feature)[TIP 195] [tcl::prefix] (spjuth) - -2008-10-04 (new feature) CONST-ified Tcl routines Tcl_GetIndexFromObj, -Tcl_RegisterConfig, Tcl_InitCustomHashTable, and routines passing -(Tcl_ChannelType *). (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2008-10-04 (bug fix)[2059262] unload only libraries marked unloadable (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2008-10-05 (new feature)[TIP 331] [lset listVar end+1 $value] (kenny) - -2008-10-05 (bug fix)[2143288] correct bad isqrt() results (boffey,kenny) - -2008-10-05 (new feature) CONST-ified return value of the -Tcl_FSFileAttrStringsProc prototype. (nijtmans) - *** POTENTIAL INCOMPATIBILITY for Tcl_Filesystems *** - -2008-10-07 (new feature)[TIP 327] [tailcall] (sofer) - -2008-10-07 (new feature)[TIP 328] [coroutine],[yield],[info coroutine] (sofer) - -2008-10-08 (bug fix)[2151707] fix stack trace from variable trace (porter) - -2008-10-10 (bug fix)[2155658] crash in oo method export (fellows) - ---- Released 8.6a3, October 10, 2008 - -2008-10-13 (bug fix) Fix ability to join threads on 64-bit Windows (thoyts) - -2008-10-23 (bug fix)[2186888] Direct-eval [for] handling of [continue] was -broken by NRE reform (sofer,porter) - -2008-10-24 (bug fix) fix failure to read SHOUTcast streams (thoyts) -=> http 2.7.2 - -2008-10-27 (enhancement) system encoding at startup is now "iso8859-1", and -no longer "identity". Use of identity encoding minimized (porter) - *** POTENTIAL INCOMPATIBILITY *** - -2008-10-31 (bug fix)[2200824] revised [oo::define] to include caller -context when resolving names. (nassau,fellows) - -2008-11-10 (bug fix)[2255235] [platform::shell::LOCATE] update (ring,kupries) -=> platform::shell 1.1.4 - -2008-11-13 (bug fix)[2269431] VFS [load] -> tempfile litter (ficicchia,nijtmans) - -2008-11-26 (bug fix)[2114900] updated tclIndex file (cassoff,kenny) - -2008-11-27 (bug fix)[2251175] [{*}{\{}] errors (hellström,ferrieux,porter) - -2008-11-29 (new feature)[TIP 210] [file tempfile] (techentin,fellows) - -2008-11-30 (bug fix)[2362156] [clock]: colon in format string (mizuno,kenny) - -2008-12-02 (bug fix)[2270477] hang in channel finalization (ferrieux,kupries) - -2008-12-02 (new feature)[TIP 336] Tcl_*ErrorLine() routines. Direct access -to the errorLine field of the interp struct denied by default. (porter) - *** POTENTIAL INCOMPATIBILITY *** - *** Define USE_INTERP_ERRORLINE to restore access for legacy code *** - -2008-12-04 (bug fix)[2385549] [file normalize] failed on some paths (porter) - -2008-12-05 (new feature)[TIP 307] Tcl_TransferResult() (leunissen,fellows) - -2008-12-05 (new feature)[TIP 335] Tcl_InterpActive() (mistachkin,fellows) - -2008-12-09 (new feature)[TIP 337] Tcl_BackgroundException() (porter) - -2008-12-10 (new feature)[TIP 341] >1 [dict filter] patterns (hellström,fellows) - -2008-12-10 (new feature)[TIP 343] [format %b $n] [scan $s %b] (ferrieux) - -2008-12-10 tzdata updated to Olson's tzdata2008i (kenny) - -2008-12-11 (new feature)[TIP 234] [zlib] and Tcl_Zlib*() (sheffers,fellows) - -2008-12-11 (bug fix)[2407783] spoil ChannelState when channel name passes -among multiple interps (kupries) - -2008-12-12 (new feature)[TIP 322] Tcl_NR*() routines to enabled non-recursive -evaluation in extensions (sofer,kenny) - -2008-12-09 (new feature)[TIP 338] Tcl_*StartupScript() (porter) - *** POTENTIAL INCOMPATIBILITY for callers of Tcl*Startup* routines *** - -2008-12-16 (new feature)[TIP 329] [try] [throw] (davel,fellows) - -2008-12-17 (new feature)[TIP 308] package tdbc 1.0b1 (kenny) - -2008-12-18 (new feature)[TIP 332] [close $chan read|write] (ferrieux) - -2008-12-18 (bug fix)[2444274] panic in long commands from {*} (goth,porter) - ---- Released 8.6b1, December 19, 2008 - -2008-12-27 [TIP 234] Tcl_Zlib* interface revisions (fellows) - *** INCOMPATIBILITY with interface of 8.6b1 *** - -2009-01-02 (platform support)[878333] IRIX compat for mkstemp() (fellows) - -2009-01-03 (bug fix)[2481670] [clock add] error message (talvo) - -2009-01-05 (bug fix)[2412068] NR-enable [source] (fellows) - -2009-01-06 (bug fix)[2489836] crash unknown method dispatch (nadkarni,fellows) - -2009-01-06 (bug fix)[2481109] fix context of instance name check (fellows) - -2009-01-08 (enhancement) more -errorcode values (fellows) - -2009-01-19 (new feature) CONFIG_INSTALL_DIR - where tclConfig.sh goes (cassoff) - -2009-01-19 (platform support) better tools for BSD ports (cassoff) - -2009-01-21 (bug fix)[2458202] exit crash with [chan create]d channel (kupries) - -2009-01-26 (bug fix)[2446662] uniformly declare EOF on RST on sockets (ferrieux) - -2009-01-26 (bug fix)[1028264] delay WSACleanup() from under our feet (ferrieux) - -2009-01-29 (bug fix)[2519474] Tcl_FindCommand() bug exposed by oo (fellows) - -2009-01-29 (bug fix)[2537939] Fix Tcl_OOInitStubs() for no-stubs build (fellows) - -2009-02-04 (bug fix)[2561746] [string repeat] overflow crash (porter) - -2009-02-05 (enhancement) optimize string operations on bytearrays (fellows) - -2009-02-12 (bug fix) enable simpler [oo::define] extension (ferri,fellows) - -2009-02-15 (bug fix)[2603158] Tcl_AppendObjToObj: append to self crash (porter) - -2009-02-17 (platform support) MSVC and _WIN64 (hobbs) - -2009-02-20 (bug fix)[2571597] [file pathtype /a] wrong result (nadkarni,porter) - -2009-03-03 (bug fix)[2662434] [zlib crc32] result now unsigned (gavilan,fellows) - -2009-03-15 (platform support) translate SIGINFO where defined (BSD) (teterin) - -2009-03-15 (bug fix)[2687952] TSD struct memleak (mistachkin) - -2009-03-18 (bug fix)[2688184] memleak in [file normalize] (mistachkin) - -2009-03-20 (bug fix)[2597185] crash in Tcl_AppendStringToObj (porter) - -2009-03-20 (bug fix)[2561794,2669109,2494093,2553906] string overflow (porter) - -2009-03-22 (bug fix)[2502037] NR-enable [namespace unknown] (sofer) - -2009-03-27 (bug fix)[2710920] [file dirname|tail /foo/] errors (epler,porter) - -2009-04-08 (bug fix)[2570363] unsafe [eval]s in tcltest (bron,porter) -=> tcltest 2.3.1 - -2009-04-08 (platform support) more Darwin kernel patterns (steffen) -=> platform 1.0.4 - -2009-04-09 (bug fix)[26245326] [http::geturl] connection failures (golovan) -=> http 2.7.3 - -2009-04-10 (new feature) Darwin: embeddable CoreFoundation notifier (steffen) - -2009-04-10 (bug fix)[1961211] Darwin [load] back-compatibility (steffen) - -2009-04-09 (new feature) http chunked+gzip modes (thoyts) -=> http 2.8.0 - -2009-04-11 (enhancement) clarified cmd name resolution in oo forwards (fellows) - -20009-04-19 (bug fix)[2715421] http: excess bytes after POST (thoyts) -=> http 2.8.1 - -2009-04-30 (bug fix)[2486550] coroutine in [interp invokehidden] (sofer) - -2009-05-07 (bug fix)[2785893] find command in deleted namespace (sofer) - -2009-05-08 (bug fix)[2414858] tailcall in oo constructor (fellows) - -2009-05-14 (new subcommand)[TIP 354] [info object namespace] (fellows) - -2009-05-29 (platform support) account for ia64_32 (kupries) -=> platform 1.0.5 - -2009-06-02 (bug fix)[2798543] incorrect [expr] integer ** results (porter) - -2009-06-10 (bug fix)[2801413] overflow in [format] (porter) - -2009-06-13 (bug fix)[2802881] corrected compile env context (tasada,porter) - -2009-06-17 (redesign) reduced ambition of [exit] finalization with aim to -avoid otherwise very tricky multi-thread finalization bugs. (staplin,ferrieux) - *** POTENTIAL INCOMPATIBILITY for exit handlers *** - -2009-06-26 (platform support) updates for Xcode 3.1 & 3.2 (steffen) - -2009-06-30 (platform support) clang static analyzer macros (steffen) - -2009-07-01 (bug fix)[2806622] Win: bad tcl_platform(user) value (thoyts) - -2009-07-05 (bug fix) zlib support asynch [chan copy] on chan transform (fellows) - -2009-07-12 (bug fix)[1895546] TclOO support for Itcl 4 method caching (fellows) - -2009-07-13 (bug fix)[1605269] NR-related [info frame] fixes (kupries) - -2009-07-14 (bug fix)[2821401] NR-enable direct eval [switch] (kenny) - -2009-07-16 (bug fix)[2819200] underflow settings on MIPS systems (porter) - -2009-07-19 (interface)[TIP 354] new routine Tcl_GetObjectName() (fellows) - -2009-07-20 (performance) favor [string is] success cases over empty (fellows) - -2009-07-22 (interface) removed TclpPanic() routine (nijtmans) - -2009-07-23 (bug fix)[2820349] plug event leak in notifier (mistachkin) - -2009-07-24 (bug fix)[2826248] crash in Tcl_GetChannelHandle (sonnenburg,kupries) - -2009-07-31 (bug fix)[2830354] overflow in [format] (misch,porter) - -2009-08-06 (bug fix)[2827000] reflected channels can signal EGAIN (kupries) - -2009-08-12 (new feature)[TIP 353] Tcl_NRExprObj() (porter) - -2009-08-20 (bug fix)[2823276] NR-enable [if], [for], [while] (fellows) - -2009-08-20 (bug fix)[2806250] EIAS violation in ~foo pathnames (porter) - -2009-08-21 (bug fix)[2837800] [glob */foo] return ./~x/foo (porter) - -2009-08-24 (bug fix) nested event loop notifier w/TkAqua Cocoa (alaoui,steffen) - -2009-08-25 (bug fix) [info frame] account for continuation lines (kupries) - -2009-08-27 (bug fix)[2845535] overflows in [format] (porter) - -2009-09-01 (bug fix) improved error message in tcltest (porter) -=> tcltest 2.3.2 - -2009-09-11 (bug fix)[2849860] http handle "quoted" charset value (fellows) -=> http 2.7.4 - -2009-09-11 (enhancement)[2314561] [subst] now bytecompiled, NR-enabled (porter) - -2009-09-24 (new feature)[TIP 356] Tcl_NRSubstObj() (porter) - -2009-10-04 (bug fix)[2569449] Core Foundation memory bug in Tiger (steffen) - -2009-10-06 (bug fix) repair intrep loss in slave interp evaluations -introduced by first versions of the NRE conversion (nadkarni,porter) - -2009-10-06 (bug fix)[1941434] broken tclTomMath.h includes (porter) - -2009-10-07 (bug fix)[2871908] leaked hash table (mistachkin,kupries) - -2009-10-08 (bug fix)[2874678] bignum leak in [dict incr] (fellows) - -2009-10-17 (bug fix)[2629338] crash in var unset traces (raney,fellows) - -2009-10-19 (bug fix)[2107634] extend [read] and [gets] to Tcl string limits -(morrison,parker,porter) - -2009-10-21 (bug fix)[2882561] Haiku OS signal support (morrison,fellows) - -2009-10-22 (bug fix)[2883857] [my varname arr(index)] (boudaillier,fellows) - -2009-10-23 (bug fix) 0-length writes: spurious SIG_PIPE (teterin,kupries) - -2009-10-24 Broken DST applied EU rules to US zones (lehenbauer,kenny) - -2009-10-29 (bug fix)[2800740] halved bignum memory on 64-bit systems (porter) - *** POTENTIAL INCOMPATIBILITY *** - -2009-11-05 (bug fix)[2854929] TM search path support in Safe Base (kupries) - -2009-11-05 (enhancement) rewrite of the Safe Base commands (kupries) - -2009-11-11 (bug fix)[2888099] [close] loses ENOSPC error (khomoutov,ferrieux) - -2009-11-11 (bug fix)[2891171] RFC 3986 compliance for ? in URL (nijtmans) -=> http 2.8.2 - -2009-11-12 (bug fix)[2895565] [fcopy -size] miscounts when converting encodings -(kupries) - -2009-11-16 (bug fix)[2891556] encoding finalization crash (mistachkin,ferrieux) - -2009-11-18 (bug fix)[2849797] consistent names for std chans (nijtmans,fellows) - *** POTENTIAL INCOMPATIBILITY *** - -2009-11-19 (enhancement) [load]able Tcltest extension (nijtmans) - -2009-11-24 (bug fix)[2893771] [file stat] on Win locked files (thoyts) - -2009-11-24 (bug fix)[2903011] crash call destructor from constructor (fellows) - -2009-12-03 (bug fix)[2906841] Safe Base [glob ../*] fixes (fellows) - -2009-12-09 (bug fix)[2901998] consistent I/O buffering (ferrieux,kupries) - -2009-12-11 (bug fix)[2806407] NR-enabled coroutines (sofer) - -2009-12-16 (bug fix)[2913616] msgcat: improved safe interp support (fellows) -=> msgcat 1.4.3 - -2009-12-22 (bug fix)[2918962] [lsort -index -stride] crash (moore,fellows) - -2009-12-23 (bug fix)[2913625] [info script/nameof] in safe interps (fellows) - -2009-12-28 (bug fix)[2891362] enable time limit in child interps (fellows) - -2009-12-29 (bug fix)[2922555] [binary decode hex { }] crash (thoyts) - -2009-12-29 (bug fix)[2895741] enable min(), max() in safe interps (fellows) - -2009-12-30 (bug fix)[2824981] guard [unknown] against [set] undef (sofer) - -2010-01-05 (bug fix)[2918610] [file rootname] corruption (magerya,porter) - -2010-01-18 (bug fix)[2932421] less [format %s] shimmer (ferrieux) - -2010-01-18 (bug fix)[2918110] [chan postevent] crash (bron,kupries) - -2010-01-21 (bug fix)[2910748] NR-enable epoch fallback direct eval (sofer) - -2010-01-30 (enhancement) [unset] now bytecompiled (fellows) - -2010-02-01 (bug fix)[2942697] faster match: some pathological regexp patterns -(lane,fellows) - -2010-02-01 (bug fix)[2939073] [array unset] unset trace crash (ferrieux) - -2010-02-02 (bug fix)[2944404] crash in oo destructor (fellows) - -2010-02-02 (new feature) [array] is now a [namespace ensemble] (fellows) - -2010-02-05 (enhancement) [error] now bytecompiled (fellows) - -2010-02-08 (bug fix)[2947783] Tcl_Zlib*flate fail on shared values (fellows) - -2010-02-09 (enhancement) [try] now bytecompiled (fellows) - -2010-02-11 (bug fix)[2826551] line-sensitive matching in regexp (dejong) - -2010-02-11 (bug fix)[2949740] [open |noSuch rb] crash (kovalenko,fellows) - -2010-02-15 (bug fix)[2950259] harden (delete obj ns -> delete obj) (fellows) - -2010-02-21 (bug fix)[2954959] get sign of abs($zero) right (nijtmans) - -2010-02-22 (bug fix)[2762041] zlib chan transforms read EOF too early (kupries) - -2010-02-27 (bug fix)[801429] Tcl_SetMainLoop() thread safety (fellows) - *** POTENTIAL INCOMPATIBILITY *** - -2010-03-02 (enhancement) -fvisibility-hidden build support (nijtmans) - -2010-03-04 (bug fix)[2962664] [oo::class destroy] crash (fellows) - -2010-03-05 (interface) TclOO typedefs for function pointers (fellows) - *** POTENTIAL INCOMPATIBILITY *** - -2010-03-09 (bug fix)[2936225] stop [chan copy] to slow channel consuming all -memory with buffer backup (ferrieux) - -2010-03-17 (bug fix)[2921116] crash in chan transfrom teardown (kupries) - -2010-03-19 (enhancement) [throw] now bytecompiled (fellows) - -2010-03-20 (enhancement) permit [fcopy] of > 2**31 bytes (fellows) - -2010-03-24 (new feature) [info object methodtype] (fellows) - -2010-03-24 (bug fix)[2383005] [return -errorcode] reject non-list (porter) - -2010-03-25 (bug fix)[2976504] broken fstatfs() call (reeuwijk,fellows) - -2010-03-30 (new feature)[TIP 362] [registry -32bit|-64bit] (courtney,fellows) -=> registry 1.3 - -2010-03-30 (bug fix)[2978773] refchan mem preservation (kupries) - -2010-04-02 (new feature)[TIP 357] Tcl_LoadFile, Tcl_FindSymbol, etc. (kenny) - -2010-04-05 (configure change)[TIP 364] default build: --enable-threads (fellows) - *** POTENTIAL INCOMPATIBILITY *** - -2010-04-02 (new feature)[TIP 348] [info errorstack], [return -errorstack] -(ferrieux) - -2010-04-20 (enhancement) update bundled zlib to 1.2.5 (nijtmans) - -2010-04-29 (enhancement)[2992970] optimize bytearray appends (fellows) - -2010-05-19 (bug fix)[3004007] dict/list shimmer w/o string rep loss (fellows) - -2010-06-09 (bug fixes) platform: several fixes for 64 bit systems (kupries) -=> platform 1.0.9 - -2010-06-16 (bug fix)[3016135] [clock format] in he_IL locale (nijtmans) - -2010-06-18 (bug fix)[3017997] Add .cmd to file extensions for [exec] (fellows) - -2010-06-28 (bug fix)[3019634] support errno.h changes in MSVC++ 2010 (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2010-07-02 (enhancement) -errorcode for [expr] domain errors (fellows) - -2010-07-28 (bug fix)[3037525] crash deleting vars @ callframe pop (sofer) - -2010-08-04 (bug fix)[3034840] mem corrupt when refchan loses interp (kupries) - -2010-08-04 (enhancement) Win [load] use LOAD_WITH_ALTERED_SEARCH_PATH (hobbs) - -2010-08-04 (platform support) panic on detection of win9x system (hobbs) - *** POTENTIAL INCOMPATIBILITY *** - -2010-08-10 (fix) Handle non-null-terminated bytearrys in glob matching (hobbs) - -2010-08-11 (fix) copy-paste bug in [yield] implementation (sofer, goth) - -2010-08-11 (platform) Drop pre-aix 4.2 support, ldAix (hobbs) - -2010-08-14 (frq)[2819611] changed signatures of hash fnctions, delete-file, and get-native-path (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2010-08-15 (bug fix)[3045010] tweaked error message for wrong#args of lambda's (fellows) - -2010-08-18 (bug fix)[3004191] fixed safe [glob] (fellows) - -2010-08-21 (patch)[3034251] genStubs steal features of ttkGenStubs (nijtmans) - -2010-08-26 (bug fix)[1230554] configure, OSF-1 problems, windows manifest issues (hobbs) - -2010-08-30 (bug fix) [3046594,3047235,3048771] reimplemented tailcall (sofer) - -2010-08-31 fixed manifest handling on windows (hobbs, kupries) - -2010-08-31 windows makefile and stub changes (nijtmans) - -2010-09-01 (bug fix)[3057639] compiled lappend trace consistency (hobbs,kupries) - *** POTENTIAL INCOMPATIBILITY *** - -2010-09-01 fixed safe glob handling of -directory (kupries) - -2010-09-02 fixed safe glob handling of -join (kupries) - -2010-09-08 (bug fix)[3059922] build with mingw on amd64 (porter, mescalinum) - -2010-09-15 (bug fix)[3067036] stop hang in bytearray append (fellows) - -2010-09-22 unified set of link libraries between mingw and vc (nijtmans) - -2010-09-22 (bug fix)[3072640] protect writes to ::error* variables (sofer) - -2010-09-23 fix leak of return options [catch $err m constant] (porter, hobbs) - -2010-09-24 (bugfix)[3056775] fixed race condition in windows sockets (kupries) - -2010-09-24 (performance) string eq/cmp (hobbs) - -2010-09-26 (patch)[3072080] rewritten NRE core (sofer) - -2010-09-28 (new feature)[TIP 162] implementation of ipv6 sockets (max) - -2010-10-02 (bug fix)[3079830] properly invalidate string rep of dicts (fellows) - -2010-10-06 (bug fix)[3081065] fix writing to freed Tcl_Obj (porter) - -2010-10-08 fix in ipv6 code on windows (nijtmans) - -2010-10-09 fixed overallocation of execution stack (sofer) - -2010-10-11 windows unicode changes (nijtmans) - -2010-10-12 (bug fix)[3084338] fixed meamleak in ipv6 code (max) - -2010-10-13 (bug fix)[467523,983660] alt fix allows empty literal share (porter) - -2010-10-15 (bugfix)[3085863] updated unicode tables (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2010-10-16 refactored implementation of dict iteration (fellows) - -2010-10-17 (patch)[2995655] report inner contexts on error stack (ferrieux) - -2010-10-19 (bug fix)[3081008] fixed bytearray zlib interaction (fellows) - -2010-10-19 improved crc, appending to bytearray (fellows) - -2010-10-20 improved compilation of [dict for] (fellows) - -2010-10-26 Added private support to disable reverse dns (max) - -2010-10-26 Prevent crashes when querying socket options (fellows, max) - -2010-10-28 (bug fix)[3093120] prevent freeaddrinfo(NULL) (porter, virden) - -2010-10-29 (bug fix)[2905784] stop cycle waste in short [after] (ferrieux) - -2010-11-01 tzdata updated to Olson's tzdata2010o (kenny) - -2010-11-04 (bug fix)[3099086] Clarified docs of var substitution (fellows) - -2010-11-04 improved install targets (cassof) - -2010-11-04 improved testing of sockets (max) - -2010-11-05 (frq)[491789] setargv/unicode cmdline for MSVC (nijtmans) - -2010-11-09 (bug fix)[3105999] fixed memleak in OO var resolver (fellows) - -2010-11-15 (TIP 378)[3081184] improved TIP 280 performance (kupries) - -2010-11-16 (platform) VS 2005 SP1 MSVC compiler (nijtmans) - -2010-11-18 (bug fix)[3111059] leak in [namespace delete] w coroutines (sofer) - -2010-11-28 [3120139,3105247] Tcl_PrintDouble improvements (kenny) - -2010-11-29 (new cmd) [tcl::unsupported::inject] (ferrieux,sofer) - -2010-11-30 (enhancement) Restore TclFormatInt for performance (hobbs) - -2010-12-09 (new feature) [file] is now a [namespace ensemble] (fellows) - -2010-12-19 (bug fix) [fcopy -size 1 -command] asynchronous (ferrieux) - -2010-12-12 (platform) OpenBSD build improvements (cassoff) - -2010-12-17 (platform) Revisions to support rpm 4.4.2 (cassoff) - -2010-12-27 (bug fix) crash in [lsort] w multiple -index options (fellows) - -2010-12-30 (bug fix)[3142026] GrowEvaluationStack OBOE (harder,sofer) - -2011-01-18 (bug fix)[3001438] [info frame -1] crash (mccormack,fellows) - -2011-03-01 (performance)[3168398] optimize [interp cancel] (mistachkin) - -2011-03-05 (bug fix)[3185009] crash in OO variables (danckaert,fellows) - -2011-03-05 (new cmd) [tcl::unsupported::assemble] (ugurlu,kenny) - -2011-03-06 (bug fix)[3200987,3192636] parser buffer overruns (porter) - -2011-03-08 (bug fix)[3202905] failed intrep release of interp result (mccormack) - -2011-03-09 (bug fix)[3202171] repair [namespace inscope] optimizer (porter) - -2011-03-10 (new version) better tcltest reporting from child interps (fellows) -=> tcltest 2.3.3 - -2011-03-10 (new feature) [namespace] is now a [namespace ensemble] (fellows) - -2011-03-12 (interface) reduce casting by ckalloc(), ckfree() callers (fellows) - -2011-03-14 (bug fix) Fixes from libtommath 0.42.0 release (fellows) - -2011-03-21 (bug fix)[3216070] [load] extension from embed Tcl apps (nijtmans) - ***POTENTIAL INCOMPATIBILITY*** - -2011-03-27 (performance) NRE: LIST lset foreach benchmark (twylite) - -2011-04-11 (bug fix)[3282869] coroutine + eval + locals crash (ferrieux,sofer) - -2011-04-13 (bug fix)[2662380] crash when variable append trace unsets (sofer) - -2011-04-13 (bug fix)[3285375] Buffer overflow in [concat] (porter) - -2011-05-02 (internals change) revised TclFindElement() interface (porter) - *** POTENTIAL INCOMPATIBILITY *** - -2011-05-05 (enhancement) dict->list w/o string rep generation (porter) - -2011-05-10 (bug fix)[3173086] Crash parsing long lists (rogers,porter) - -2011-05-24 (enhancement) msgcat internal improvements (fellows) -=> msgcat 1.4.4 - -2011-05-25 (TIP 381) [info object|class call] [self call] [nextto] (fellows) - -2011-05-31 (bug fix)[3293874] let lists grow all the way to the limit (porter) - -2011-06-02 (bug fix)[3185407] cmd resolution epoch flaw (nadkarni,fellows) - -2011-06-13 (bug fix)[3315098] mem leak generating double string rep (neumann) - -2011-06-22 (new feature) DEB_HOST_MULTIARCH support (kupries) -=> platform 1.0.10 - -2011-07-15 (bug fix)[3357771] Prevent circular refs in bytecode (porter) - -2011-07-28 tzdata updated to Olson's tzdata2011h (porter) - -2011-08-01 (bug fix)[3383616] memleak exposed by XOTcl (neumann,sofer) - -Many more Tcl built-in command errors now set an -errorcode. - ---- Released 8.6b2, August 8, 2011 - -2011-07-02 (bug fix)[3349507] correct double(1[string repeat 0 23]) (kenny) - -2011-07-19 (bug fix)[3371644] Tcl_ConvertElement() segfault (sader, ferrieux) - -2011-07-21 (bug fix)[3372130] hypot(.) segfault (nijtmans) - -2011-08-12 (bug fix)[3389764] memleaks due to reference cycles in dup'd paths - -2011-08-15 (bug fix)[3390272] leak of [info script] value (porter) - -2011-08-17 (bug fix)[3393150] bignum leaks in Tcl_Get*() routines (porter) - -2011-08-18 (bug fix)[3393714] [string toupper] overflow (nijtmans) - -2011-08-30 (bug fix)[3398794] panic in interp limit setting (gavlian,fellows) - -2011-09-08 (bug fix)[3401704] revised expr parser to permit function names -like "nano()" instead of parsing as "nan o()" with missing op (duquette,porter) - *** POTENTIAL INCOMPATIBILITY *** - -2011-09-10 (bug fix)[3400658] wrong num args msg with TclOO (rsooltan,fellows) - -2011-09-13 (bug fix)[3390638] solaris studio cc workaround (kechel,porter) - -2011-09-13 (bug fix)[3405652] DTrace workaround (michelson,porter) - -2011-09-16 (bug fix)[3391977] -headers overrides -type (ziegenhagen,fellows) -=> http 2.8.3 - -2011-09-16 (TIP 388) New \Uhhhhhhhh syntax (nijtmans) - -2011-10-06 (enhancement) bytecode compile [dict with] (fellows) - -2011-10-11 (bug fix)[2935503] [file stat] returns bad mode (nadkarni,nijtmans) - -2011-10-20 (bug fix)[3418547] cmd lits and custom resolvers (soberning,fellows) - -2011-10-31 (bug fix)[3414754] EIAS violation in fs paths (porter) - -2011-11-22 (bug fix)[3354324] Win: [file mtime] sets wrong time (nijtmans) - -2011-11-30 (bug fix)[967195] Simply args passed to child processes (nijtmans) -=> tcltest 2.3.4 - -2011-12-07 (bug fix)[3444754] fix [string tolower \u01C5] (nijtmans) - -2011-12-11 (update)[3457031] Update [[:print:]] to Unicode 6.0 (nijtmans) - -2011-12-24 (bug fix)[3464428] fix [string is graph \u0120] (nijtmans) - -2012-01-08 (bug fix)[3470928] zoneinfo trouble with Windhoek data file (kenny) - -2012-01-13 (bug fix)[3472316] fix retrieval of socket error (fellows) - -2012-01-21 (bug fix)[3475667] [regexp] buffer read overflow (sebres) - -2012-01-22 (bug fix)[3475264] [dict exists] return 0, not error (fellows) - -2012-01-25 (bug fix)[3474460] [oo::copy] var resolution list (fellows) - -2012-01-26 (bug fix)[3475569,3479689] mem corrupt in fs path (sebres,porter) - -2012-01-30 (enhancement) improve bytecode compile of [catch] (fellows) - -2012-02-02 (bug fix)[2974459,2879351,1951574,1852572,1661378,1613456] Fix -problems where [file *able] would return false results on Win/Samba (porter) - -2012-02-06 (bug fix)[3484621] bump bytecode epoch on exec traces (kuhn,sofer) - -2012-02-15 (bug fix)[3487626] crash compiling [dict for] (fellows) - -2012-02-15 (enhancement) bytecode compile [lrange],[lreplace] (fellows) - -2012-02-17 (bug fix)[2233954] compile problem on AIX & Android (nijtmans) - -2012-02-29 (bug fix)[3466099] BOM in Unicode (nijtmans) - -2012-03-07 (bug fix)[3498327] RFC 3986 compliance (kupries) - -2012-03-26 (TIP 380) New builtin class [oo::Slot] (fellows) - *** POTENTIAL INCOMPATIBILITY *** - -2012-03-27 (TIP 397) method to extend [oo::copy] (fellows) - *** POTENTIAL INCOMPATIBILITY *** - -2012-03-27 (TIP 395) New subcommand [string is entier] (fellows) - -2012-04-02 (TIP 396) New command [yieldto] (fellows) - -2012-04-04 (bug fix)[3514761] crash combining objects and ensembles (fellows) - -2012-04-09 (bug fix)[2712377] [info vars] and oo variables (fellows) - -2012-04-09 (bug fix)[3396896] no dups in oo var lists (fellows) - -2012-04-11 (bug fix)[3448512] [clock scan 1958-01-01] fail on Win (nijtmans) - -2012-04-15 (bug fix)[3517696] fix flush of zlib chan xform (fellows) - -2012-04-18 tzdata updated to Olson's tzdata2012c (kenny) - -2012-04-28 (TIP 398) exit non-blocking chan without flush (ferrieux) - *** POTENTIAL INCOMPATIBILITY *** - -2012-05-02 (enhancement) Better use of Intel cpuid instruction (nijtmans) - -2012-05-03 (bug fix)[3428753] Unbreak synchronous [socket -async] (porter) - -2012-05-10 (bug fix)[2812981] force consistent config of Tcl+pkgs (ferrieux) - -2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans) - -2012-05-17 (bug fix)[3445787] fix [file] ensemble in Safe Base (fellows) - -2012-05-17 (bug fix)[2964715] fix [glob] in Safe Base (fellows) - -2012-05-17 (bug fix)[3106532] proper [switch -indexvar] values (fellows) - *** POTENTIAL INCOMPATIBILITY *** - -2012-05-21 (TIP 106) New -binary option to [dde execute|poke] (oehlmann) -=> dde 1.4.0 - -2012-05-23 (bug fix)[3525907] [zlib push decompress] & [chan event] -(fellows,ferrieux,kupries) - -2012-05-28 (bug fix)[3529949] Protect ~ paths in Safe Base (fellows) - -2012-06-21 (bug fix)[3362446] [registry keys] failure (nijtmans) -=> registry 1.3.0 - -2012-06-25 (bug fix)[3537605] [encoding dirs a b] error message (fellows) - -2012-06-25 (bug fix)[3024359] crash when multi-thread concurrent [file system] -and Tcl_FSMountsChanged(). (porter) - -2012-06-29 (bug fix)[3536888] fix locale guessing (oehlmann,nijtmans) - -2012-07-05 (bug fix)[1189293] make "<<" redirect binary safe (porter) - -2012-07-08 (bug fix)[3531209] accept IPv6 URLs (max) -=> http 2.8.4 - -2012-07-24 (bug fix) stop mem corruption in stacked channel events (max,porter) - -2012-07-25 (bug fix)[3546275] [auto_execok] search match [exec] (danckaert) - -2012-07-27 (update)[3464401] Support Unicode 6.2 (nijtmans) - -2012-08-20 (bug fix)[3559678] [file normalize] EIAS failure (phao,dgp) - -2012-08-25 (bug fix)[3561330] Ukranian translation of "March" (teterin) - -2012-09-07 (TIP 404) New msgcat commands [mcflset], [mcflmset] (oehlmann) -=> msgcat 1.5.0 - -Many revisions to better support a Cygwin environment (nijtmans) - -Dropped support for OS X versions less than 10.4 (Tiger) (fellows) - ---- Released 8.6b3, September 18, 2012 - -2012-09-20 (enhancement) full Unicode support (nijtmans) -=> dde 1.4.0 - -2012-09-20 (enhancement) update bundled zlib to 1.2.7 (nijtmans) - -2012-10-03 (bug fix) exit panic on stacked std channel (griffin,porter) - -2012-10-14 (bug fix) [tcl::Bgerror] crash on non-dict options (nijtmans) - -2012-10-16 (TIP 400) New [zlib] options to set compression dict (fellows) - -2012-10-16 (TIP 405) New commands [lmap] and [dict map] (fellows) - -2012-10-24 (enhancement) [dict unset] now bytecompiled (fellows) - -2012-11-05 (TIP 413) Revisions to default [string trim*] trimset (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2012-11-05 (enhancement) Now bytecompiled: [array exists], [array set], -[array unset], [dict create], [dict exists], [dict merge], [format], -[info commands], [info coroutine], [info level], [info object], -[namespace current], [namespace code], [namespace qualifiers], [namespace tail], -[namespace which], [regsub], [self], [string first], [string last], -[string map], [string range], [tailcall], [yield]. (fellows) - -2012-11-06 (bug fix)[3581754] avoid multiple callback on keep-alive (fellows) -=> http 2.8.5 - -2012-11-07 tzdata updated to Olson's tzdata2012i (kenny) - -2012-11-13 (bug fix)[3567063] thread fp settings from master (mistachkin) - -2012-11-14 (bug fix)[2933003] tempfile creation in $TMPDIR (fellows) - -2012-11-15 (TIP 416) New [load] options -global and -lazy (nijtmans) - -2012-11-20 (bug fix)[3033307] base64 trail whitespace (kovalenko,goth) - -2012-12-03 (bug fix) [configure] query broke init from argv (porter) -=> tcltest 2.3.5 - -2012-12-13 (bug fix)[3595576] crash: [catch {} -> noSuchNs::var] (sofer,porter) - -2012-12-13 (bug fix) crash: [zlib gunzip $data -header noSuchNs::var] (porter) - ---- Released 8.6.0, December 20, 2012 - -2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd) - -2012-12-27 (bug fix)[3598580] Tcl_ListObjReplace() refcount fix (nijtmans) - -2013-01-04 (bug fix) memleak in [format] compiler (fellows) - -2013-01-08 (bug fix)[3092089,3587096] [file normalize] on junction points - -2013-01-09 (bug fix)[3599395] status line processing (nijtmans) -2013-01-23 (bug fix)[2911139] repair async connection management (fellows) -=> http 2.8.6 - -2013-01-26 (bug fix)[3601804] Darwin segfault platformCPUID (nijtmans) - -2013-01-28 (enhancement) improve ensemble bytecode (fellows) - -2013-01-30 (enhancement) selected script code improvements (fradin) -=> tcltest 2.3.6 - -2013-01-30 (bug fix)[3599098] update to handle glibc banner changes (kupries) -=> platform 1.0.11 - -2013-01-31 (bug fix)[3598282] make install DESTDIR support (cassoff) - -2013-02-05 (bug fix)[3603434] [file normalize a:/] flaw in VFS (porter,griffin) - -2013-02-09 (bug fix)[3603695] $obj varname resolution rules (venable,fellows) - -2013-02-11 (bug fix)[3603553] zlib flushing errors (vampiera,fellows) - -2013-02-14 (bug fix)[3604576] msgcat use of Windows registry (oehlmann,nijtmans) -=> msgcat 1.5.1 - -2013-02-19 (bug fix)[2438181] report errors in trace handlers (yorick) - -2013-02-21 (bug fix)[3605447] unbreak [namespace export -clear] (porter) - -2013-02-23 (bug fix)[3599194] fallback IPv6 routines (afredd,max) - -2013-02-27 (bug fix)[3606139] stop crash in [regexp] (lane) - -2013-03-03 (bug fix)[3606258] major serial port update (english) - -2013-03-06 (bug fix)[3606683] [regexp (((((a)*)*)*)*)* {}] hangs -(grathwohl,lane,porter) - -2013-03-12 (enhancement) better build support for Debian arch (shadura) - -2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans) - -2013-03-21 (bug fix)[2102614] [auto_mkindex] ensemble support (griffin) - -2013-03-27 Tcl_Zlib*() routines tolerate NULL interps (porter - -2013-04-04 (bug fix) Support URLs with query but no path (max) -=> http 2.8.7 - -2013-04-08 (bug fix)[3610026] regexp crash on color overflow (linnakangas) - -2013-04-29 (enhancement) [array set] compile improvement (fellows) - -2013-04-30 (enhancement) broaden glibc version detection (kupries) -=> platform 1.0.12 - -2013-05-06 (platform support) Cygwin64 (nijtmans) - -2013-05-15 (enhancement) Improved [list {*}...] compile (fellows) - -2013-05-16 (platform support) mingw-4.0 (nijtmans) - -2013-05-19 (platform support) FreeBSD updates (cerutti) - -2013-05-20 (bug fix)[3613567] access error temp file creation (keene) - -2013-05-20 (bug fix)[3613569] temp file open fail can crash [load] (keene) - -2013-05-22 (bug fix)[3613609] [lsort -nocase] failed on non-ASCII (fellows) - -2013-05-28 (bug fix)[3036566] Use language packs (Vista+) locale (oehlmann) -=> msgcat 1.5.2 - -2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter) - -2013-06-03 Restored lost performance appending to long strings (elby,porter) - -2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows) - -2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1F (nijtmans) - -2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans) - -2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang) - -2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin) - -2013-07-06 tzdata updated to Olson's tzdata2013d (kenny) - -2013-07-10 (bug fix)[86fb5e] [info frame] in compiled ensembles (porter) - -2013-07-18 (bug fix)[1c17fb] revisd syntax errorinfo that shows error (porter) - -2013-07-26 (bug fix)[6585b2] regexp {(\w).*?\1} abb (lane) - -2013-07-29 [string is space \u202f] => 1 (nijtmans) - -2013-08-01 [a0bc85] Limited support for fork with threads (for Rivet) (nijtmans) - -2013-08-01 (bug fix)[1905562] RE recursion limit increased to support -reported usage of large expressions (porter) - -2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows) - -2013-08-03 (enhancement)[3611643] [auto_mkindex] support TclOO (fellows) - -2013-08-14 (bug fix)[a16752] Missing command delete callbacks (porter) - -2013-08-15 (bug fix)[3610404] reresolve traced forwards (porter) - -2013-08-15 Errors from execution traces become errors of the command (porter) - -2013-08-23 (bug fix)[8ff0cb9] Tcl_NR*Eval*() schedule only, as doc'd (porter) - -2013-08-29 (bug fix)[2486550] enable [interp invokehidden {} yield] (porter) - -2013-09-01 (bug fix)[b98fa55] [binary decode] fail on whitespace (reche,fellows) - -2013-09-07 (bug fix)[86ceb4] have tm path favor first provider (neumann,porter) - -2013-09-09 (bug fix)[3609693] copied object member variable confusion (fellows) -=> TclOO 1.0.1 - -2013-09-17 (bug fix)[2152292] [binary encode uuencode] corrected (fellows) - -2013-09-19 (bug fix)[3487626] segfaults in [dict] compilers (porter) - -2013-09-19 (bug fix)[31661d2] mem leak in [lreplace] (ade,porter) - -Many optmizations, improvements, and tightened stack management in bytecode. - ---- Released 8.6.1, September 20, 2013 --- https://core.tcl-lang.org/tcl/ for details - -2013-09-27 (enhancement) improved ::env synchronization (fellows) - -2013-10-20 (bug fix)[2835313] segfault from -[apply {{} {while 1 {a {*}[return -level 0 -code continue]}}}] (fellows) - -2013-10-22 (bug fix)[3556215] [scan %E%G%X] support (fellows) - -2013-10-25 (bug fix)[3eb2ec1] upper case scheme names in url. (nijtmans) -=> http 2.8.8 - -2013-10-29 (bug fix)[414d103] HP-UX: restore [exec] in threaded Tcl (nijtmans) - -2013-11-04 (bug fix) C++ friendly stubs struct declarations (nijtmans) - -2013-11-05 (bug fix)[426679e] OpenBSD man page rendering (nijtmans) - -2013-11-12 (bug fix)[5425f2c] [fconfigure -error] breaks [socket -async] - -2013-11-20 (bug fix) Improved environment variable management (nijtmans) -=> tcltest 2.3.7 - -2013-11-21 (platforms) Support for Windows 8.1 (nijtmans) - -2013-12-06 (RFE) improved [foreach] bytecode (fellows) - -2013-12-10 (RFE) improved [lmap] bytecode (sofer) - -2013-12-11 (RFE) improved [catch] bytecode (sofer) - -2013-12-18 (bug fix)[0b874c3] SEGV [coroutine X coroutine Y info frame] (porter) - -2013-12-20 (RFE) reduced numeric conversion in bytecode (sofer) - -2014-01-07 (RFE) compilers for [concat], [linsert], [namespace origin], -[next], [string replace], [string tolower], [string totitle], [string toupper], -[string trim], [string trimleft], [string trimright] (fellows) - -2014-01-22 (RFE) compilers for [nextto], [yieldto] (fellows) - -2014-02-02 (RFE) compiler for [string is] (fellows) - -2014-02-06 (bug fix)[a4494e2] panic in test namespace-13.2 (porter) - -2014-03-20 (bug fix)[2f7cbd0] FreeBSD 10.0 build failure (nijtmans) - -2014-03-26 (RFE)[b42b208] Cygwin: [file attr -readonly -archive -hidden -system] -(nijtmans) - -2014-03-27 (bug fix) segfault iocmd-23.11 (porter) - -2014-04-02 (bug fix)[581937a] Win: readable event on async connect failure - -2014-04-04 (bug fix)[581937a,97069ea] async socket connect fail (oehlmann) - -2014-04-10 (bug fix)[792641f] Win: no \ in normalized path (nijtmans) - -2014-04-11 (bug fix)[3118489] protect NUL in filenames (nijtmans) - -2014-04-15 (bug fix)[88aef05] segfault iocmd-21.20 (porter) - -2014-04-16 (update) Win: use Winsock 2.2 (nijtmans) - -2014-04-16 (bug fix)[d19a30d] segfault clock-67.[23] (sebres) - -2014-04-21 (bug fix) segfault iocmd-21.2[12] (porter) - -2014-04-22 (bug fix) segfault iogt-2.4 (porter) - -2014-04-23 (bug fix)[3493120] memleak in thread exit - -2014-05-08 refactoring of core I/O functions (porter) - -2014-05-09 (bug fix)[3389978] Win: extended paths support (nijtmans) - -2014-05-09 (bug fix) segfault iocmd-32.1 (porter) - -2014-05-11 (bug fix)[6d2f249] nested ensemble compile failure (fellows) - -2014-05-17 (RFE)[47d6625] wideint support in [lsearch -integer] [lsort -integer] (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2014-05-20 (bug fix) Stop eof and blocked state leaking thru stacks (porter) - *** POTENTIAL INCOMPATIBILITY *** - -2014-05-20 (bug fix)[13d3af3] Win: socket -async tried only first IP address - -2014-05-28 (platforms) work around systems that fail when a shared library -is deleted after it is [load]ed (kupries) - -2014-05-31 (bug fix) chan events on pipes must be on proper ends (porter) - -2014-06-04 (bug fix) socket-2.12 (porter) - -2014-06-05 (bug fix) io-12.6 (kupries,porter) - -2014-06-15 (RFE)[1b0266d] [dict replace|remove] return canonical dict (fellows) - *** POTENTIAL INCOMPATIBILITY *** - -2014-06-16 (bug fix) socket-2.13 workaround broken select() (porter) - -2014-06-20 (bug fix)[b47b176] iortrans.tf-11.0 (porter) - -2014-06-22 (RFE)[2f9df4c] -cleanup scripts before -out compare (nijtmans) - -2014-07-04 (update) Update Unicode data to 7.0 (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2014-07-08 (bug) [chan push] converts blocked writes to error (aspect,porter) - -2014-07-10 (bug fix)[7368d2] memleak Tcl_SetVar2(..,TCL_APPEND_VALUE) (porter) - *** POTENTIAL INCOMPATIBILITY *** - -2014-07-11 (bug) leaks in SetFsPathFromAny, [info frame] (porter) - -2014-07-15 (bug) compress dict leak in zlib xform channel close (porter) - -2014-07-17 (bug fix)[9969cf8] leak trace data in coroutine deletion (porter) - -2014-07-18 (RFE)[b43f2b4] fix [lappend] multi performance collapse (fellows) - -2014-07-19 (bug fix)[75b8433] memleak managing oo instance lists (porter) - -2014-07-21 (bug fix)[e6477e1] memleak in AtForkChild() (porter) - -2014-07-22 (bug fix)[12b0997] memleak in iocmd.tf-32.0 (porter) - -2014-07-28 (RFE) Optimized binary [chan copy] by moving buffers (porter) - -2014-07-30 (enhancement) use refcounts, not Tcl_Preserve to manage lifetime -of Tcl_Channel (porter) - *** POTENTIAL INCOMPATIBILITY *** - -2014-07-31 (bug fix)[a84a720] double free in oo chain deletion (porter) - -2014-08-01 (bug fix)[e75faba] SEGV [apply {{} {namespace upvar a b [x]}}] (porter) - -2014-08-01 (update) "macosx*-i386-x86_64" "macosx-universal" no longer compatible (kupries) -=> platform 1.0.13 - -2014-08-12 tzdata updated to Olson's tzdata2014f (kenny) - -2014-08-17 (bug fix)[7d52e11] [info class subclasses oo::object] should -include ::oo::class (fellows) - -2014-08-25 (TIP 429) New command [string cat] (leitgeb,ferrieux) - ---- Released 8.6.2, August 27, 2014 --- https://core.tcl-lang.org/tcl/ for details - -2014-08-28 (bug)[b9e1a3] Correct Method Search Order (nadkarni,fellows) -=> TclOO 1.0.3 - *** POTENTIAL INCOMPATIBILITY *** - -2014-09-05 (bug)[ccc2c2] Regression [lreplace {} 1 1] (bron,fellows) - -2014-09-08 (bug) Crash regression in [oo::class destroy] (porter) - -2014-09-09 (bug)[84af11] Regress [regsub -all {\(.*} a(b) {}] (fellows) - -2014-09-10 (bug)[cee90e] [try {} on ok {} - on return {} {}] panic (porter) - -2014-09-20 (feature) [tcl::unsupported::getbytecode] disassember (fellows) - -2014-09-27 (enhancement) [string cat] bytecode optimization (leitgeb,ferrieux) - -2014-09-27 (bug)[82521b] segfault in mangled bytecode (ogilvie,sofer) - -2014-10-02 (bug)[bc5b79] Hang in some [read]s of limited size (rogers,porter) - -2014-10-03 (bug)[bc1a96] segfault in [array set] of traced array (tab,porter) - -2014-10-08 (bug)[59a2e7] MSVC14 compile support (dower,nijtmans) - -2014-10-10 (bug)[ed29c4] [fcopy] treats [blocked] as error (rowen,porter) - -2014-10-10 (bug)[bf7135] regression in Tcl_Write() interface (porter) - -2014-10-18 (bug)[10dc6d] fix [gets] on non-blocking channels (fassel,porter) - -2014-10-26 Support for Windows 10 (nijtmans) - -2014-10-31 (bug)[dcc034] restore [open comX: r+] (lll,nijtmans) - -2014-11-05 (bug)[214cc0] Restore [lappend v] return value (sayers,porter) - -2014-11-06 (bug)[5adc35] Stop forcing EOF to be permanent (porter) - ---- Released 8.6.3, November 12, 2014 --- https://core.tcl-lang.org/tcl/ for details - -2014-11-21 (bug)[743338] Win: socket error encoding (ladayaroslav,nijtmans) - -2014-12-01 (bug) restore tbcload/tclcompiler support (kupries) - -2014-12-03 (bug)[0c043a] Fix compiled [set var($) val] (porter) - -2014-12-04 (bug)[d2ffcc] Limit $... and bareword parsing to ASCII (ladayaroslav,porter) - *** POTENTIAL INCOMPATIBILITY *** - -2014-12-06 (bug)[c6cd4a] Win: hang in async socket connection (shults,nadkarni) - -2014-12-10 tzdata updated to Olson's tzdata2014j (venkat) - -2014-12-13 fix header files installation on OS X (houben) - -2014-12-17 (TIP 427) [fconfigure $h -connecting, -peername, -sockname] (oehlmann,rmax) - -2014-12-18 (bug)[af08c8] Crash in full finalize encoding teardown (porter) - -2014-12-18 (bug)[7c187a] [chan copy] crash (io-53.17) (benno,porter) - -2015-01-26 (bug)[df0848] Trouble with INFINITY macro (dower,nijtmans) - -2015-01-29 (bug) Stop crashes when extension var resolvers misbehave (porter) - -2015-01-29 (bug)[088727] [read] past EOF (io-73.4) (fenugrec,porter) - -2015-02-11 tzdata updated to Olson's tzdata2015a (venkat) - -2015-02-20 (bug)[32b615] Fix compiled [lreplace] (lreplace-4.[345]) (aspect) - -2015-03-10 (enhancement) Revise OS X notifier for better Cocoa (walzer) - *** POTENTIAL INCOMPATIBILITY *** - ---- Released 8.6.4, March 12, 2015 --- https://core.tcl-lang.org/tcl/ for details - -2015-03-19 (bug)[e66e44] Win: Ctrl-C/Ctrl-Break in console not EOF (nadkarni) - -2015-03-21 (bug)[d87cb1] Proper tailcall from compiled ensembles (sofer) - -2015-04-23 (bug)[19ea02] Win: shared read from linked dirs (bogdan,oehhar) - -2015-04-24 (bug)[879a07] Incomplete chars @ buffer ends (leunissen,porter) - -2015-04-29 (bug)[894da1] Hang flushing blocking channels (yorick) - -2015-05-14 (enhance)[b9d043] Default use of gzip transfer encoding (fellows) -=> http 2.8.9 - *** POTENTIAL INCOMPATIBILITY *** - -2015-05-15 (bug)[9dd1bd] destructor [self] after failed constructor (calvo,fellows) - -2015-05-15 (bug)[0f42ff] [tailcall] combined with [next] (aspect,fellows) - -2015-05-18 (bug)[c11a51] http: race condition in -accept option (fellows) - -2015-05-19 (enhance) More pure lists from compiled [list] (porter,fellows) - -2015-05-27 (enhancement) Relax memdebug constraint on extensions (kupries) - -2015-06-03 (bug)[268b23] crash in traced [expr] (execute-11.2)(tomkinson,porter) - -2015-06-11 (bug)[478c44] Memleak in zlib compresion errors (mistachkin) - -2015-06-16 (bug)[e770d9] Higher baud on serial channels (woods,nijtmans) - -2015-06-18 (update) Update Unicode data to 8.0 (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2015-06-18 (bug)[a4cb3f] compiled [lreplace] handling of end (bron,aspect) - -2015-06-23 (enhance) Use Unicode SendMessageTimeout() (nijtmans) -=> registry 1.3.1 - -2015-06-25 (TIP 412) msgcat dynamic locale change and package private locale (oehlmann) -=> msgcat 1.6.0 - -2015-07-05 (bug)[a0ece9] crash in traced [expr] (execute-11.3) (hans,porter) - -2015-07-10 (TIP 436) [info object isa] favors 'false' over error (fellows) -=> TclOO 1.0.4 - -2015-07-15 (bug)[b1534b][9bad63] writes beyond buffer bounds (hanno,porter) - -2015-07-18 (bug)[a3309d] Memleak in compiled [unset a($i)] (jeff,porter) - -2015-07-23 (bug)[57945b] lock in forking/multi-threading (neumann,mistachkin) - -2015-07-29 (bug)[3e7eca] Allocation overflow in expr parsing (rickyb,porter) - -2015-07-30 (bug)[f00009] Win: Memleak in [file] (rp,sebres) - -2015-07-31 (bug) Correct problems found in Coverity audit (sofer) - -2015-08-19 (bug)[00189c] MSVC 14: semi-static UCRT support (dower,nijtmans) - -2015-08-26 (bug)[0df7a1] Tolerate getcwd() failures (cato,nijtmans) - -2015-09-21 (bug)[1115587][a3c350][d7ea9f][0e0e15][187d7f] Many fixes and -improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich) - -2015-09-23 (enhance) hash lookup microoptimization (hipp) - -2015-09-23 (bug)[e0a7b3] Input buffer draining & file events (griffin,porter) - -2015-09-29 (bug)[219866] Cygwin support error (yorick,nijtmans) -=> platform 1.0.14 - -2015-10-06 (bug)[b42a85] Win: [file normalize ~user] wrong dir (nadkarni) - -2015-10-21 (bug)[1080042][8f2450] More regexp from Postgres (lane,porter) - -2015-10-23 (bug)[4a0c16] [clock] react to msgcat locale change (oehlmann) - -2015-11-10 (bug)[261a8a] Overflow segfault in I/O translation (brooks,porter) - -2015-11-20 (bug)[40f628] ListObjReplace callers fail to detect max (porter) - -2015-11-30 (enhance)[32c574] Improve list growth performance (brooks,porter) - -2015-12-11 (bug)[c9eb6b] tolerate unset ::env(TZ) (gahr, nijtmans) - -2016-01-29 (TIP 440) tcl_platform(engine) -- Tcl implementation (mistachkin) - -2016-02-03 (bug)[25842c] stream [zlib deflate] fails with 0 input (ade,fellows) - -2016-02-04 (bug)[3d96b7][593baa][cf74de] crashes in OO teardown (porter,fellows) - -2016-02-22 (bug)[9b4702] [info exists env(missing)] kills trace (nijtmans) - ---- Released 8.6.5, February 29, 2016 --- https://core.tcl-lang.org/tcl/ for details - -2016-03-01 (bug)[803042] mem leak due to reference cycle (porter) - -2016-03-08 (bug)[bbc304] reflected watch race condition (porter) - -2016-03-17 (bug)[fadc99] compile-5.3 (rodriguez,porter) - -2016-03-17 (enhancement)[1a25fd] compile [variable ${ns}::v] (porter) - -2016-03-20 (bug)[1af8de] crash in compiled [string replace] (harder,fellows) - -2016-03-21 (bug)[d30718] segv in notifier finalize (hirofumi,nijtmans) - -2016-03-23 (enhancement)[7d0db7] parallel make (yarda,nijtmans) - -2016-03-23 [f12535] enable test bindings customization (vogel,nijtmans) - -2016-04-04 (bug)[47ac84] compiled [lreplace] fixes (aspect,ferrieux,fellows) - *** POTENTIAL INCOMPATIBILITY *** - -2016-04-08 (bug)[866368] RE \w includes 'Punctuation Connector' (nijtmans) - -2016-04-08 (bug)[2538f3] Win crash Tcl_OpenTcpServer() (griffin) - -2016-04-10 [07d13d] Restore TclBlend support lost in 8.6.1 (buratti) - -2016-05-13 (bug)[3154ea] Mem corruption in assembler exceptions (tkob,kenny) - -2016-05-13 (bug) registry package support any Unicode env (nijtmans) -=> registry 1.3.2 - -2016-05-21 (bug)[f7d4e] [namespace delete] performance (fellows) - -2016-06-02 (TIP 447) execution time verbosity option (cerutti) -=> tcltest 2.4.0 - -2016-06-16 (bug)[16828b] crash due to [vwait] trace undo fail (dah,porter) - -2016-06-16 (enhancement)[4b61af] good [info frame] from more cases (beric) - -2016-06-21 (bug)[c383eb] crash in [glob -path a] (oehlmann,porter) - -2016-06-21 (update) Update Unicode data to 9.0 (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2016-06-22 (bug)[16896d] Tcl_DString tolerate append to self. (dah,porter) - -2016-06-23 (bug)[d55322] crash in [dict update] (yorick,fellows) - -2016-06-27 (bug)[dd260a] crash in [chan configure -dictionary] (madden,aspect) - -2016-07-02 (bug)[f961d7] usage message with parameters with spaces (porter) - *** POTENTIAL INCOMPATIBILITY *** - -2016-07-02 (enhancement)[09fabc] Sort order of -relateddir (lanam) - -2016-07-07 (bug)[5d7ca0] Win: [file executable] for .cmd and .ps1 (nadkarni) - *** POTENTIAL INCOMPATIBILITY *** - -2016-07-08 (bug)[a47641] [file normalize] & Windows junctions (nadkarni) - -2016-07-09 [ae61a6] [file] handling of Win hard-coded names (CON) (nadkarni) - *** POTENTIAL INCOMPATIBILITY *** - -2016-07-09 [3613671] [file owned] (more) useful on Win (nadkarni) - -2016-07-09 (bug)[1493a4] [namespace upvar] use of resolvers (beric,fellows) - *** POTENTIAL INCOMPATIBILITY *** - -2016-07-10 (bug)[da340d] integer division in clock math (nadkarni) - -2016-07-20 tzdata updated to Olson's tzdata2016f (venkat) - ---- Released 8.6.6, July 27, 2016 --- https://core.tcl-lang.org/tcl/ for details - -2016-09-07 (bug)[c09edf] Bad caching with custom resolver (neumann,nijtmans) - -2016-09-07 (bug)[4dbdd9] Memleak in test var-8.3 (mr_calvin,porter) - -2016-10-03 (bug)[2bf561] Allow empty command as alias target (yorick,nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2016-10-04 (bug)[4d5ae7] Crash in async connects host no address (gahr,fellows) - -2016-10-08 (bug)[838e99] treat application/xml as text (gahr,fellows) -=> http 2.8.10 - -2016-10-11 (bug)[3cc1d9] Thread finalization crash in zippy (neumann) - -2016-10-12 (bug)[be003d] Fix [scan 0x1 %b], [scan 0x1 %o] (porter) - -2016-10-14 (bug)[eb6b68] Fix stringComp-14.5 (porter) - -2016-10-30 (bug)[b26e38] Fix zlib-7.8 (fellows) - -2016-10-30 (bug)[1ae129] Fix memleak in [history] destruction (fellows) - -2016-11-04 (feature) Provisional Tcl 9 support in msgcat and tcltest (nijtmans) -=> msgcat 1.6.1 -=> tcltest 2.4.1 - -2016-11-04 (bug)[824752] Crash in Tcl_ListObjReplace() (gahr,porter) - -2016-11-11 (bug)[79614f] invalidate VFS mounts on sytem encoding change (yorick) - -2016-11-14 OSX: End panic() as legacy support macro; system conflicts (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2016-11-15 (bug) TclOO fix stops crash mixing Itcl and snit (fellows) - -2016-11-17 (update) Reconcile libtommath updates; purge unused files (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2017-01-09 (bug)[b87ad7] Repair drifts in timer clock (sebres) - -2017-01-17 (update) => zlib 1.2.11 (nijtmans) - -2017-01-31 (bug)[39f630] Revise Tcl_LinkVar to tolerate some prefixes (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2017-02-01 (bug)[d0f7ba] Improper NAN optimization. expr-22.1[01] (aspect) - -2017-02-26 (bug)[25842c] zlib stream finalization (aspect) - -2017-03-07 (deprecate) Remove unmaintained makefile.bc file (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2017-03-14 (enhancement) [clock] and [encoding] are now ensembles (kenny) - -2017-03-15 (enhancement) several [clock] subcommands bytecoded (kenny) - -2017-03-23 tzdata updated to Olson's tzdata2017b (jima) - -2017-03-29 (bug)[900cb0] Fix OO unexport introspection (napier) - -2017-04-12 (bug)[42202b] Nesting imbalance in coro injection (nadkarni,sebres) - -2017-04-18 (bug)[bc4322] http package support for safe interps (nash,nijtmans) - -2017-04-28 (bug)[f34cf8] [file join a //b] => /b (neumann,porter) - -2017-05-01 (bug)[8bd13f] Windows threads and pipes (sebres,nijtmans) - -2017-05-01 (bug)[f9fe90] [file join //a b] EIAS violation (aspect,porter) - -2017-05-04 (bug) Make test filesystem-1.52 pass on Windows (nijtmans) - -2017-05-05 (bug)[601522] [binary] field spec overflow -> segfault (porter) - -2017-05-08 (bug)[6ca52a] http memleak handling keep-alive (aspect,nijtmans) -=> http 2.8.11 - -2017-05-29 (bug)[a3fb33] crash in [lsort] on long lists (sebres) - -2017-06-05 (bug)[67aa9a] Tcl_UtfToUniChar() revised handling invalid UTF-8 (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2017-06-08 (bug)[2738427] Tcl_NumUtfChars() corner case utf-4.9 (nijtmans) - -2017-06-22 (update) Update Unicode data to 10.0 (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2017-06-22 (TIP 473) Let [oo::copy] specify target namespace (fellows) - -2017-06-26 (bug)[46f801] Repair autoloader fragility (porter) - -2017-07-06 (bug)[adb198] Plug memleak in TclJoinPath (sebres,porter) - -2017-07-17 (bug)[fb2208] Repeatable tclIndex generation (wiedemann,nijtmans) - ---- Released 8.6.7, August 9, 2017 --- https://core.tcl-lang.org/tcl/ for details - -Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7, -plus the following, which focuses on the high-level feature changes -in this changeset (new minor version) rather than bug fixes: - -2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter) - *** POTENTIAL INCOMPATIBILITY *** - -2016-07-01 Hack accommodations for legacy Itcl 3 disabled (porter) - -2016-07-12 Make TCL_HASH_TYPE build-time configurable (nijtmans) - -2016-07-19 (bug)[0363f0] Partial array search ID reform (porter) - -2016-07-19 (feature removed) Tcl_ObjType "array search" unregistered (porter) - *** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("array search") *** - -2016-10-04 Server socket on port 0 chooses port supporting IPv4 * IPv6 (max) - -2016-11-25 [array names -regexp] supports backrefs (goth) - -2017-01-04 (TIP 456) New routine Tcl_OpenTcpServerEx() (limeboy) - -2017-01-04 (TIP 459) New subcommand [package files] (nijtmans) - -2017-01-16 threaded allocator initialization repair (vasiljevic,nijtmans) - -2017-01-30 Add to Win shell builtins: assoc ftype move (ashok) - -2017-03-31 TCL_MEM_DEBUG facilities better support 64-bit memory (nijtmans) - -2017-04-13 \u escaped content in msg files converted to true utf-8 (nijtmans) - -2017-05-18 (TIP 458) New epoll or kqueue notifiers are default (alborboz) - -2017-05-31 Purge build support for SunOS-4.* (stu) - -2017-06-22 (TIP 463) New option [regsub ... -command ...] (fellows) - -2017-06-22 (TIP 470) Tcl_GetDefineContextObject();[oo::define [self]] (fellows) -=> TclOO 1.2.0 - -2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin) - -2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann) - -2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter) - ---- Released 8.7a1, September 8, 2017 --- https://core.tcl-lang.org/tcl/ for details - -2017-08-10 [array names -regexp] supports backrefs (goth) - -2017-08-10 Fix gcc build failures due to #pragma placement (cassoff,fellows) - -2017-08-29 (bug)[b50fb2] exec redir append stdout and stderr to file (coulter) - -2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann) -=> http 2.8.12 - -2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter) - -2017-10-19 (bug)[1a5655] [info * methods] includes mixins (fellows) - -2017-10-23 tzdata updated to Olson's tzdata2017c (jima) - -2017-10-24 (bug)[fc1409] segfault in method cloning, oo-15.15 (coulter,fellows) - -2017-11-03 (bug)[6f2f83] More robust [load] for ReactOS (werner) - -2017-11-08 (bug)[3298012] Stop crash when hash tables overflow 32 bits (porter) - -2017-11-14 (bug)[5d6de6] Close failing case of [package prefer stable] (kupries) - -2017-11-17 (bug)[fab924] Fix misleading [load] message on Windows (oehlmann) - -2017-12-05 (bug)[4f6a1e] Crash when ensemble map and list are same (sebres) - -2017-12-06 (bug)[ce3a21] file normalize failure when tail is empty (porter) - -2017-12-08 (new)[TIP 477] nmake build system reform (nadkarni) - -2017-12-19 (bug)[586e71] EvalObjv exception handling at level #0 (sebres,porter) - ---- Released 8.6.8, December 22, 2017 --- https://core.tcl-lang.org/tcl/ for details - -2018-02-11 (enhance) stop blocking conversion of object to/from class (coulter) - -2018-02-12 (enhance) NR-enable [package require] (coulter) - -2018-02-14 (bug)[9fd5c6] crash in object deletion, test oo-11.5 (coulter) - -2018-02-14 (bug)[3c32a3] crash deleting object with class mixed in (coulter) - -2018-02-15 (platform) stop using -lieee, removed from glibc-2.27 (porter) -***POTENTIAL INCOMPATIBILITY for math programs that embed Tcl*** - -2018-02-23 (bug)[8e6a9a] bad binary [string match], test string-11.55 (porter) - -2018-03-05 (bug)[1873ea] repair multi-thread std channel init (sebres) - -2018-03-09 (bug)[db36fa] broken bytecode for index values (porter) - -2018-03-13 (bug) broken compiled [string replace], test string-14.19 (porter) - -2018-03-14 (bug) [string trim*] engine crashed on invalid UTF (sebres) - -2018-04-17 (bug) missing trace in compiled [array set], test var-20.11 (porter) - -2018-04-22 (bug)[46a241] crash in unset array with search, var-13.[23] (goth) - -2018-04-30 (bug)[27b682] race made [file delete] raise "no such file" (sebres) - -2018-06-04 (bug)[925643] 32/64 cleanup of filesystem DIR operations (sebres) - -2018-06-18 (bug) leaks in TclSetEnv and env cache (coulter) - -2018-06-24 (bug)[3592747] [yieldto] dying namespace, tailcall-14.1 (coulter) - -2018-07-09 (bug)[270f78] race in [file mkdir] (sebres) - -2018-07-12 (bug)[3f7af0] [file delete] raised "permission denied" (sebres) - -2018-07-26 (bug)[d051b7] overflow crash in [format] (sebres) - -2018-08-29 revised quoting of [exec] args in generated command line (sebres) -***POTENTIAL INCOMPATIBILITY*** - -2018-09-20 HTTP Keep-Alive with pipelined requests (nash) -=> http 2.9.0 - -2018-09-27 (new)[TIP 505] [lreplace] accepts all out of range indices (porter) - -2018-10-04 (bug) Prevent crash from NULL keyName (nijtmans) -=> registry 1.3.3 - -2018-10-26 (enhance) advance dde version (nijtmans) -=> dde 1.4.1 - -2018-10-27 tzdata updated to Olson's tzdata2018g (jima) - -2018-10-29 Update tcltest package for Travis support (fellows) -=> tcltest 2.5.0 - -2018-11-09 (bug)[35a8f1] overlong string length of some lists (owens) - -2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres) - -- Released 8.6.9, November 16, 2018 - details at https://core.tcl-lang.org/tcl/ - - -2018-11-22 (bug)[7a9dc5] [file normalize ~/~foo] segfault (sebres) - -2018-12-30 (bug)[3cf3a9] variable 'timezone' deprecated in vc2017 (nijtmans) - -2019-01-09 (bug)[cc1e91] [list [list {*}[set a " "]]] regression (sebres) - -2019-02-01 (bug)[e3f481] tests var-1.2[01] (sebres) - -2019-03-01 (new) Update to Unicode 12.0 (nijtmans) - -2019-03-05 (new)[TIP 527] New command [timerate] (sebres) - -2019-03-08 (bug)[39fed4] [package require] memory validity (hume,porter) - -2019-04-23 (new) New command tcl::unsupported::corotype (fellows) - -2019-05-04 (bug) memlink when namespace deletion kills linked var (porter) - -2019-05-28 (new) README file converted to README.md in Markdown (nijtmans) - -2019-06-17 (bug)[8b9854] [info level 0] regression with ensembles (porter) - -2019-06-20 (bug)[6bdadf] crash multi-arg write-traced [lappend] (fellows,porter) - -2019-06-21 (bug)[f8a33c] crash Tcl_Exit before init (brooks,sebres) - -2019-08-27 (bug)[fa6bf3] Bytecode fails epoch recovery at numLevel=0 (sebres) - -2019-08-29 (bug)[fec0c1] C stack overflow compiling bytecode (ade,sebres) - -2019-09-12 tzdata updated to Olson's tzdata2019c (jima) - -2019-09-20 (new) registry/dde no longer need -DUNICODE (nijtmans) -=> registry 1.3.4 -=> dde 1.4.2 - -2019-10-02 (bug)[16768d] Fix [info hostname] on NetBSD (rytaro) - -2019-10-23 (new) libtommath updated to release 1.2.0 (nijtmans) - -2019-10-25 OSX: system Tcl deprecated. End default use of its packages. (walzer) - -2019-10-28 (bug)[bcd100] bad fs cache when system encoding changes (coulter) - -2019-11-15 (bug)[135804] segfault in [next] after destroy (coulter,sebres) - -2019-11-18 (bug)[13657a] application/json us text, not binary (noe,nijtmans) -=> http 2.9.1 - -- Released 8.6.10, Nov 21, 2019 - details at https://core.tcl-lang.org/tcl/ - - -Changes to 8.7a3 include all changes to the 8.6 line through 8.6.10, -plus the following, which focuses on the high-level feature changes -in this changeset (new minor version) rather than bug fixes: - -2017-11-01 (bug)[3c32a3] crash deleting class mixed into instance (coulter) - -2017-11-03 [TIP 345] eliminate the encoding 'identity' (porter) - -2017-11-04 (bug)[0d902e] [string first] on ASCII stored as Unicode (fellows) - -2017-11-17 [TIP 422] Mark all Tcl_*VA() routines deprecated. (nijtmans) - -2017-11-20 (support) Ended use of the obsolete values.h header (culler) - -2017-11-30 (bug)[8e1e31] [lsort] ordering of U+0000 (nijtmans) - -2017-12-07 [TIP 487] Terminate support for pre-XP Windows (nijtmans) - -2017-12-08 [TIP 477] Reform of nmake build (nadkarni) - -2017-12-20 (bug)[ba1419] Crash: complex ensemble delete, namespace-7.8 (coulter) - -2018-01-17 [TIP 485] Removal of many deprecated features (nijtmans) - -2018-01-27 (bug) Crash in [join $l $l], join-4.1 (porter) - -2018-02-06 [TIP 493] Cease Distribution of http 1.0 (porter) - -2018-02-06 [TIP 484] internal rep for native ints are all 64-bit (nijtmans) - -2018-02-14 [TIP 476] Scan/Printf consistency (nijtmans) - -2018-03-05 [TIP 351] [lsearch] striding - -2018-03-05 [TIPs 330,336] tighten access to Interp fields (porter) - -2018-03-12 [TIP 462] [::tcl::process] - -2018-03-12 [TIP 490] add oo support for msgcat => msgcat 1.7.0 (oehlmann) - -2018-03-12 [TIP 499] custom locale preference list (oehlmann) -=> msgcat 1.7.0 - -2018-03-20 [TIP 503] End CONST84 support for Tcl 8.3 (porter) - -2018-03-30 Refactored [lrange] (spjuth) - -2018-04-20 [TIP 389] Unicode beyond BMP (nijtmans) - -2018-04-20 [TIP 421] [array for] - -2018-05-11 [TIP 425] Windows panic callback use of UTF-8 - -2018-05-17 [TIP 491] Phase out --disable-threads support - -2018-06-03 [TIP 500] TclOO Private Methods and Variables - -2018-07-26 (bug)[ba921a] [string cat] of bytearrays (coulter,porter) - -2018-09-02 [TIP 478] Many new features in TclOO (lester,fellows) - -2018-09-04 (bug)[540bed] [binary format w] from bignum (nijtmans) - -2018-09-12 [TIP 430] zipfs and embedded script library (woods) - -2018-09-26 [TIP 508] [array default] (bonnet,fellows) - -2018-09-27 [TIP 515] level value reform (nijtmans) - -2018-09-27 [TIP 516] More OO slot operations (fellows) - -2018-09-27 [TIP 426] [info cmdtype] (fellows) - -2018-09-28 [TIP 509] Cross platform reentrant mutex - -2018-10-08 [TIP 514] native integers are 64-bit - -2018-10-12 [TIP 502] index value reform (porter) - -2018-11-06 [TIP 406] http cookies (fellows) - -2018-11-06 [TIP 445] Tcl_ObjType utilities (migrate to Tcl 9) (porter) - -2018-11-06 [TIP 501] [string is dict] - -2018-11-06 [TIP 519] inline export/unexport option for [oo::define] - -2018-11-06 [TIP 523] [lpop] - -2018-11-06 [TIP 524] TclOO custom dialects - -2018-11-06 [TIP 506] Tcl_(Incr|Decr)RefCount macros -> functions (porter) - -2018-11-15 [TIP 512] No stub for Tcl_SetExitProc() - -2019-04-08 (bug)[45b9fa] crash in [try] (coulter) - -2019-04-14 [TIP 160] terminal and serial channel controls - -2019-04-14 [TIP 312] more types for Tcl_LinkVar - -2019-04-14 [TIP 367] [lremove] - -2019-04-14 [TIP 504] [string insert] - -2019-04-16 [TIP 342] [dict getwithdefault] - -2019-04-23 (bug)[67a5ea] make [chan postevent] asynchronous - *** POTENTIAL INCOMPATIBILITY *** - -2019-05-25 [TIP 431] [file tempdir] - -2019-05-25 [TIP 383] [coroinject], [coroprobe] - -2019-05-31 [TIP 544] Tcl_GetIntForIndex() - -2019-06-12 Replace TclOffset() with offsetof() - -2019-06-15 [TIP 461] string compare operators for [expr] - -2019-06-16 [TIP 521] floating point classification functions for [expr] - -2019-06-20 (bug)[6bdadf] crash multi-arg traced [lappend] (fellows) - -2019-06-28 [TIP 547] New encodings utf-16, ucs-2 - -2019-09-14 [TIP 414] Tcl_InitSubsystems() - -2019-09-14 [TIP 548] wchar_t conversion functions - -- Released 8.7a3, Nov 21, 2019 --- https://core.tcl-lang.org/tcl/ for details - - -Changes to 9.0a1 include all changes to the 8.7 line through 8.7a3, -plus the following, which focuses on the high-level feature changes -in this changeset (new minor version) rather than bug fixes: - -2017-11-03 [TIP 114] Leading zero integer no longer means octal - -2017-11-03 [TIP 278] Revise variable name resolution, solve "Creative Writing" - -2017-11-03 [TIPs 330,336] Encapsulate struct Tcl_Interp - -2017-11-17 [TIP 422] Remove all Tcl_*VA() routines - -2017-12-15 [TIP 488] Disable magic $::tcl_precision - -2018-10-08 [TIP 494] Increased support for size_t value ranges - -2019-05-31 [TIP 537] 64-bit indices in regexp matching - -- Released 9.0a1, Nov 25, 2019 --- https://core.tcl-lang.org/tcl/ for details - - -2019-12-03 (bug)[3cd9be] Corner case in surrogate handling (nijtmans) - -2019-12-09 (new) Add tcltest::(Setup|Eval|Cleanup|)Test (coulter,sebres) -=> tcltest 2.5.2 - -2019-12-12 (new) Add 3 libtommath functions to stub table (nijtmans) - -2019-12-23 (bug)[ce3b9f] compilation errors with clang, windows msys2 (nijtmans) - -2019-12-27 (bug)[1de6b0] [expr 1e2147483648] => 0.0 (kbk) - -2020-01-04 (bug)[912886] tis-620 encoding fails to load (coulter) - -2020-01-13 (bug)[0b9332] Win: support system encoding init to utf-8 (jedlička) - -2020-01-17 (bug)[8cd2fe] [unload] corrupted list of loaded packages (berc) - -2020-01-17 (bug)[5d989f] segfault in lsort for large list length (sebres) - -2020-01-30 (bug) Reset WSAGetLastError()/errno in channel close (nijtmans) - -2020-02-17 (bug) Win: avoid create of legacy error-vars on init phase (sebres) - -2020-02-25 (bug) release refs when setting class's superclasses fails (dkf) - -2020-02-26 (bug) C++ compiler compatibility for registry and dde (nijtmans) -=> registry 1.3.5 -=> dde 1.4.3 - -2020-03-05 (new) Update to Unicode-13 (nijtmans) - -2020-03-16 (bug)[8f89e2] Win: env var encoding, env-2.5 (sebres, nijtmans) - -2020-03-27 (bug)[767e07] Tcl_Get(Range|UniChar) validate index inputs (nijtmans) - -2020-03-28 (bug)[8edfce] [binary encode base64] & multi-byte wrapchars (dgp) - -2020-03-28 (bug)[ffeb20] [binary decode base64] ignore invalid chars (dgp) -See RFC 2045 - *** POTENTIAL INCOMPATIBILITY *** - -2020-03-31 (bug)[b8e82d] some -maxlen values break uuencode round trip (dgp) - *** POTENTIAL INCOMPATIBILITY *** - -2020-04-01 (bug)[f58371] Fileevent run in proper thread (bron,sebres) - -2020-04-13 (bug)[afa4b2] TclNeedSpace bug; tests util-8.5 .. util-8.11 (dgp) - -2020-04-13 (bug)[085913] Tcl_DStringAppendElement # quoting precision (dgp) - *** POTENTIAL INCOMPATIBILITY *** - -2020-04-13 (bug)[a7f685] test util-5.52 (dgp) - -2020-04-13 (bug)[c61818] Tcl_UtfPrev regression (dgp) - -2020-04-15 (bug)[8af92d] zlib transform issue, bad inflate (sebres) - -2020-04-16 (bug)[5e6346] Tcl_UtfPrev handling of overlong sequences (dgp) - -2020-04-27 (bug)[45ca23] [string tolower] inconsistency (dgp) - -2020-04-30 (bug)[da2352] init [info hostname] with DNS, not NetBIOS (nadkarni) - -2020-05-11 (bug)[d402ff] Win32 potential crash when using main() (werner) - -2020-05-13 (bug)[81242a] revised documentation for Tcl_UtfAtIndex() (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2020-05-13 (bug)[ed2980] Tcl_UtfToUniChar reads > TCL_UTF_MAX bytes (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2020-06-02 (bug) prevent segfault in parser (sebres) - -2020-06-21 (bug)[f81bec] http POST a binary file (alakendu,nash) -=> http 2.9.2 - -2020-06-23 (bug)[41c985] auto_path nonsense in Safe Base (nash) - -2020-06-24 (bug)[f70ce1] zlib multi-stream inflate acts only on first (sebres) - -2020-07-09 (bug)[a1bd37] [clock scan] new ISO format (clock-34.(19-24)) (sebres) - *** POTENTIAL INCOMPATIBILITY *** - -2020-07-10 (bug)[501974] [clock scan] +time zone (clock-34.(53-68)) (sebres) - *** POTENTIAL INCOMPATIBILITY *** - -2020-07-15 (bug)[3c6e47] compiled [lappend] performance, avoid copy (sebres) - -2020-07-16 (bug)[5bbd04] Fix index underflow (schwab) - -2020-07-27 (bug)[cb0373] http::geturl -keepalive fixes (nash) -=> http 2.9.3 - -2020-08-10 (bug)[29e884] cmd resolution cycle (namespace-57.0) (coulter,sebres) - -2020-08-12 (bug)[e87000] Tcl_BadChannelOption tolerate NULL (werner,nijtmans) - -2020-08-31 (TIP #581) disfavor Master/Slave terminology (nijtmans) -=> opt 0.4.8 - -2020-09-11 (bug)[3bc0f4] UBSan complains about body.chars[] usage (nijtmans) - -2020-09-17 (bug)[835c93] Support TIP 525 exit code for -singleproc 1 (nijtmans) -=> tcltest 2.5.3 - -2020-09-25 (new) force -eofchar \x1A when evaluating library scripts (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2020-09-29 (bug)[0063cb] http::geturl -headers must be dict (oehlmann,nijtmans) - -2020-10-19 (bug)[cb4582] Update install-sh script (stu,nijtmans) - -2020-10-22 (bug)[c97593] Usage of gnu_printf in latest mingw-w64 (nijtmans) - -2020-10-26 (new)[48898a] improve error message consistency (stu) - *** POTENTIAL INCOMPATIBILITY *** - -2020-11-06 (new) revised case of module names (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2020-12-10 (bug)[ed5be7] Win: recognize "comx:" as serial port (oehlmann) - -2020-12-11 (new) support for msys2, Big Sur (nijtmans) -=> platform 1.0.15 - -2020-12-23 tzdata updated to Olson's tzdata2020e (jima) - -- Released 8.6.11, Dec 31, 2020 - details at https://core.tcl-lang.org/tcl/ - - -Changes to 8.7a5 include all changes to the 8.6 line through 8.6.11, -plus the following, which focuses on the high-level feature changes -in this changeset (new minor version) rather than bug fixes: - -2019-12-13 [TIP 538] Externalize libtommath - -2020-01-20 [TIP 542] Support for switchable Full Unicode support - -2020-01-21 [TIP 543] Eliminate `TCL_INTERP_DESTROYED` flag value - -2020-01-24 [TIP 559] Eliminate public routine `Tcl_FreeResult - -2020-01-31 (new) Implement 64-bit seek on Zip channels. (nijtmans) - -2020-02-28 [TIP 557] C++ support for Tcl - -2020-02-28 [TIP 562] Deprecate channel types 1-4 - -2020-03-11 (bug)[234d6c] Segfault in [set l {}; lpop l] (sebres) - -2020-03-12 (bug) Crash in tests binary-79.[12] (porter) - -2020-03-13 [TIP 569] Eliminate Comments That Serve Lint - -2020-04-06 (bug)[dd010c] [string trim*] on astral characters (porter,nijtmans) - -2020-05-30 [TIP 551] Permit underscore in numerical literals in source code - -2020-07-03 [TIP 578] Death to TCL_DBGX - -2020-08-11 (bug)[e87000] Win32 crash in [fconfigure stdout] (werner,nijtmans) - -2020-09-06 (bug)[c1a376] deletion trace on imported ensemble (coulter) - -2020-09-13 [TIP 585] Promote the INDEX_TEMP_TABLE flag of Tcl_GetIndexFromObj*() to the public interface - -2020-09-15 (bug)[b5777d] crash in [string index abcd 0-0x10000000000000000] - -2020-09-19 [b9ecf3] revised stork mgmt [uplevel [list $cmd ...]] (coulter) - -2020-10-23 [TIP 587] Default utf-8 for source command - -2020-10-27 (bug)[11229b] test string-31.26.* (porter) - -2020-11-08 [TIP 582] Comments in Expressions - -2020-11-16 [TIP 586] C String Parsing Support for binary scan - -2020-12-07 [TIP 590] Recommend lowercase Package Names - -2021-01-06 Bump to tcltest 2.5.4 - -2021-01-15 [TIP 481] `Tcl_GetStringFromObj()` with `size_t` length parameter - -2021-01-15 [TIP 592] End support: Windows XP, Server 2003, Vista, Server 2008 - -2021-01-25 tzdata updated to Olson's tzdata2021a (nijtmans) - -2021-01-29 (bug)[113be1] zipfs on mac - -2021-03-15 [TIP 575] Switchable Tcl_UtfCharComplete()/Tcl_UtfNext()/Tcl_UtfPrev() - -2021-03-19 (new)[0221b9] Drop TCL_WINDOW_EVENTS from Tcl's [update idletasks] - -2021-03-30 (new)[4b4830] [chan truncate] for reflected channels - -2021-04-30 [TIP 597] "string is unicode" and better utf-8/utf-16/cesu-8 encodings - -2021-04-09 [TIP 598] export TclWinConvertError - -2021-05-15 (bug)[463b7a] segfault from Tcl_Unload (coulter) - -2021-05-15 (bug)[fb2a41] tclZipfs.c free all memory (coulter) - -2021-05-18 (bug)[688fcc,28027d] namespace teardown reform (coulter) - -- Released 8.7a5, Jun 18, 2021 --- https://core.tcl-lang.org/tcl/ for details - - -Changes to 9.0a3 include all changes to the 8.7 line through 8.7a5, -plus the following, which focuses on the high-level feature changes -in this changeset (new major version) rather than bug fixes: - -Many of the TIPs in Tcl 8.7 mentioned above are extended further in 9.0 - -2020-02-28 [TIP 497] Full support for Unicode planes 1-16 - -2020-08-21 (bug)[43b434] improper calls to stat64() - -2021-04-08 [TIP 595] Unicode-aware loadable library handling. - -2021-04-30 [TIP 596] Stubs support for embedding Tcl in apps - -Many internal changes to broaden support for sizes beyond 32-bits. - -- Released 9.0a3, Jun 23, 2021 --- https://core.tcl-lang.org/tcl/ for details - - -2021-02-02 (new) support for MacOS Big Sur updates (nijtmans) -=> platform 1.0.17 - -2021-02-15 (bug)[d43f96] [string trim*] broken for Emoji (werner) - -2021-02-16 (bug)[22324b] [string reverse] broken for Emoji (werner) - -2021-02-19 (bug)[1dab71,7c64aa] BRE broken by uninitialized value use (lane) - -2021-03-09 (bug)[8419c5] Unix tty channels tolerate EINTR (nijtmans) - *** POTENTIAL INCOMPATIBILITY *** - -2021-03-10 (bug)[4c591f] [string compare] EIAS violation (nijtmans) - -2021-04-08 (new) dde package installation compatible with Tcl 9 (nijtmans) -=> dde 1.4.4 - -2021-04-14 (bug)[266494] [concat foo [list #]] EIAS violation (porter) - -2021-05-03 (bug)[24b918] Save IO buffers from modern optimizers (rupprecht) - -2021-05-06 (new) support for POSIX error EILSEQ (nijtmans) - -2021-05-17 (bug)[688fcc] segfault during traced delete of alias (coulter) - -2021-06-22 (bug)[bad6cc] More secure build tool. CVE-2021-35331 (nijtmans) - -2021-07-17 (bug)[592a25] Win: segfault in Tcl_PutEnv() (danckaert,nijtmans) - -2021-09-02 (bug)[ccc448] segfault in ensemble rewrite machinery (coulter) - -2021-09-14 (new) Update to Unicode-14 (nijtmans) - -2021-10-08 (bug)[a8579d] failed proc argument spec processing (russell,coulter) - -2021-10-27 (new) support for MacOS Monterey (nijtmans) -=> platform 1.0.18 - -2021-10-27 tzdata updated to Olson's tzdata2021e (nijtmans) - -- Released 8.6.12, Nov 5, 2021 - details at https://core.tcl-lang.org/tcl/ - - -2021-12-08 (update) tcltest package to version 2.5.4 - -2022-01-13 (bug)[26f132] Crash when sizeof(int) < sizeof(void *) (Plan 9 port) - -2022-01-19 (TIP 623)[e9a271] Tcl_GetRange index args < 0 (petasis,nijtmans) - -2022-03-08 (bug) test string-5.22 (porter) - -2022-03-11 (bug)[8a7ec8] fat binary compile on Mac M1 (davis, nijtmans) - -2022-04-04 (bug)[e5ed1b] numeric IPv6 in URLs (nijtmans) -=> http 2.9.6 - -2022-04-26 (bug)[27520c] test error-9.6 (goth,sebres) - -2022-05-04 (bug)[8eb64b] http package tolerant again invalid reply header - -2022-05-11 (bug)[6898f9] http package failed detection of shiftjis charset - -2022-05-25 (bug)[76ad7a] tests string-6.13[23] (mistachkin, nijtmans) - -2022-06-20 (bug)[55bf73] Avoid connection reuse after response code 101. -=> http 2.9.8 - -2022-07-22 (bug)[713653] FP rounding exposed by x86 musl (rubicon,sebres) - -2022-07-22 More portable notation of microseconds in verbose output (sebres) -=> tcltest 2.5.5 - -2022-07-27 (bug)[b3977d] Process CR-LF split across packets (nadkarni,sebres) - -2022-07-29 (bug)[4eb3a1] crash due to undetected bytecode invalidity (nadkarni) - -2022-08-23 (new)[371080] Portability to CHERI-enabled Morello processor (jrtc27) - -2022-09-06 (bug)[55a02f] Fallback init env(HOME) from USERPROFILE (nadkarni) - -2022-09-13 (bug)[1073da] crash writing invalid utf-8 (nijtmans) - -2022-09-14 (new) Update to Unicode-15 (nijtmans) - -2022-10-14 tzdata updated to Olson's tzdata2022e (nijtmans) - -Update bundled zlib to 1.2.13 - -Update bundled libtommath - -Many code fixes to avoid overflow or undefined behavior. Thanks chrstphrchvz. - -- Released 8.6.13, Nov 22, 2022 - details at https://core.tcl-lang.org/tcl/ - - -2022-12-01 Backport TIP #402: path name starting with '//' not - replaced by '/' also on Cygwin and QNX (nijtmans) - -2022-12-12 Windows binaries licence metadata changed to University of - California to match licence (nadkarni) - -2022-12-16 check mknod, tcdrain and uname in build script for VxWorks or others - (nijtmans) - -2022-12-16 32-bit cygwin is dead, so --enable-64bit in a Cygwin build no longer - needed (nijtmans) - -2023-01-01 (bug)[8e811b] Wrong formatting of arguments in man page (nijtmans) - -2023-01-06 (bug) [0f19ed]: Windows 11 not reported in tcl_platform(osVersion) - (nijtmans) - -2023-01-15 (bug) [8f7fde] string compare failing on big endian (coulter) - -2023-01-22 (bug) [3e8074] y2k38 problem in [interp limit time -seconds] - (nijtmans) - -2023-01-22 (bug) [e3dcab] crash with tcl_precision equal 15..18 (kenny) - -2023-02-22 (bug) [d19fe0] output replacement character on incomplete sequences - in unicode encoding (nijtmans) - -2023-02-22 (bug) [534172] sporadic crash in memchan thread cleanup. - (neumann,nijtmans) - -2023-02-28 (bug) [f9eafc] throw error in zip command when file comment/filename - to long or not iso-latin-1 (nijtmans) - -2023-03-04 (bug) [1b8df1] fix usec on windows returned by Tcl_GetTime (nadkarni) - -2023-03-05 (bug) [9c5a00]. Fix ~ and ~user path prefix on Windows (nadkarni) - -2023-03-13 (bug)[183a1a] Prevent BO by Tcl_UtfToExternal (nadkarni) - -2023-03-14 (bug) [ea69b0], crash when using a channel transformation on TCP - client socket (coulter) - -2023-03-22 (bug)[026575] Prevent invalid read in Tcl_UtfToUniChar (nijtmans) - -2023-03-30 (rfe) Allow empty mode in [chan create] to allow refchan version of - [socket -server] (max) - -2023-03-30 [0cb355] macOS 13 SDK deprecates sprintf() (chavez) - -2023-05-02 (bug) [ab123c] argument position overflow in [scan %num$mode] - (nadkarni) - -2023-05-02 (bug) [784bef] tailcall crash (nadkarni) - -2023-06-03 (bug) [af3ebc] clock scan and clock add bugs in error cases / with - abbreviated options (ade) - -2023-07-05 (bug) [66ffaf] incomplete double byte encoding sequences ignored like - in [encoding convertfrom gb12345 x] (nadkarni) - -2023-07-26 (rfe) [c54e4a] fork multithreading performance by using vfork/spawn - when supported (neumann) - -2023-08-29 Update zlib to version 1.3 (nijtmans) - -2023-09-04 Update libtommath to version 1.2.1 (nijtmans) - -2023-09-05 (bug) [60cacf] Fix tclvfs tkt Segmentation Fault at interpreter exit - when tclvfs loaded. -2023-09-05 (bug) [b5ac3e] Tcl_GetUniChar reads beyond string length for ASCII - strings (nadkarni) - -2023-09-06 (bug) [d3465c] Update install-sh to version 2020-11-14.01 (nijtmans) - -2023-09-08 Unicode 15.1 (nijtmans) - -2023-09-12 Remove option utf16 from win/makefile.vc (nijtmans) - -2023-09-13 (bug) [43b065] MS Windows: files with emojis are found by glob but - not recognized by file exists or open (nijtmans) - -2023-09-13 (bug) [a1f11d] VC6 compilation error of core-8-6-branch: error C2065: - 'int16_t' : undeclared identifier (nijtmans) - -2023-09-14 (bug) [00655c] ClockGetdatefieldsObjCmd(): avoid signed integer - overflow and platform-dependent behavior (nijtmans) - -2023-09-28 TIP #662: Tcl_VarEval is not depreciated any more (nijtmans) - -2023-10-01 (bug) [7b3167] tclOO.c: initialize fakeObject.refCount (nijtmans) - -2023-10-04 (bug) [7371b6] AddressSanitizer use-after-return detection breaks NRE - tests, coroutines (nijtmans) - -2023-11-20 (bug)[32b889] prevent spurious errors from [clock format] (gahr) - -2023-11-30 (bug) [fb2fa9],[21b062] reallow [exec %var%] on MS-Windows. It was - forbidden in 8.6.13 (brester) - -2023-12-30 (rfe) [0ac9d0] Don't call getsockname(2) in Tcl_MakeFileChannel(3) - unless absolutely necessary. Permits better constraining of Tcl/tclsh - via OpenBSD's pledge(2) or similar mechanisms. Minor rewrite. - -2024-01-09 (feature) Adapt tcltest to support Tcl 9. -=> tcltest 2.5.7 - -2024-01-11 (bug) [fd27ad] doc change of Tcl_PkgRequire & friends: version string - specification refers to "package require". - -2024-01-27 (bug) [16e25e] error for [tcl_startOfPreviousWord string end-1] - (nijtmans) - -2024-01-29 Update to zlib 1.3.1 (nijtmans) - -2024-01-29 [db4f28] segfault when Tcl_ReadChars is called with unicode object - (brester) - -2024-02-04 tzdata updated to Olson's tzdata2024a (nijtmans) - -2024-02-05 fix/document Tcl_ObjPrintf with "ll" modifier (nijtmans) - -2024-02-06 [8e666d] endless loop when redefining proc ::history (nash) - -2024-02-06 [86b3c1] endless loop when ::unknown is moved into a namespace (nash) - -- Released 8.6.14, Feb 28, 2024 - details at https://core.tcl-lang.org/tcl/ - - -Changes to 9.0b2 include all changes to the 8.6 line through 8.6.14 -and all changes to the 8.7 line through 8.7a5 -plus the following, which focuses on the high-level feature changes -in this changeset (new major version) rather than bug fixes: - -- Released 9.0b2, Mar ??, 2024 - details at https://core.tcl-lang.org/tcl/ - -- cgit v0.12 From 54480407eac9a36f6fad948cf074073c057e62a2 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 5 Apr 2024 15:45:04 +0000 Subject: changes file removal sequel --- unix/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index baebacd..9e839c6 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2339,7 +2339,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in gen $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic - $(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/README.md \ + $(DIST_INSTALL_DATA) $(TOP_DIR)/README.md \ $(TOP_DIR)/license.terms $(DISTDIR) $(INSTALL_DATA_DIR) $(DISTDIR)/library $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ -- cgit v0.12 From abc5adf5fd455d973e0cd41eba54b6e894e03ff7 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 24 Apr 2024 18:39:51 +0000 Subject: dup test name --- tests/ioCmd.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 7f27266..2a6defa 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -496,14 +496,14 @@ test iocmd-12.10 {POSIX open access modes: BINARY} { close $f set result } 5 -test iocmd-12.11 {POSIX open access modes: BINARY} -body { +test iocmd-12.10.1 {POSIX open access modes: BINARY} -body { after 100 set f [open $path(test1) {WRONLY BINARY TRUNC}] puts $f Ɉ ;# throws an exception } -cleanup { close $f } -returnCodes 1 -match glob -result {error writing "*": invalid or incomplete multibyte or wide character} -test iocmd-12.12 {POSIX open access modes: BINARY} { +test iocmd-12.11 {POSIX open access modes: BINARY} { set f [open $path(test1) {WRONLY BINARY TRUNC}] puts $f H close $f -- cgit v0.12 From 92237847179354aba876b7908ecf77351b5ca6b6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 30 Apr 2024 14:00:46 +0000 Subject: Check for C11 before using _Static_assert --- generic/tclDecls.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 73ab405..5bec80e 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4032,7 +4032,7 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_GetIndexFromObjStruct #undef Tcl_GetBooleanFromObj #undef Tcl_GetBoolean -#if !defined(__cplusplus) && !defined(BUILD_tcl) && !defined(BUILD_tk) && !defined(_MSC_VER) +#if !defined(__cplusplus) && !defined(BUILD_tcl) && !defined(BUILD_tk) && defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 201112L) # define TCLBOOLWARNING(boolPtr) (void)(sizeof(struct {_Static_assert(sizeof(*(boolPtr)) <= sizeof(int), "sizeof(boolPtr) too large");int dummy;})), #elif defined(__GNUC__) /* If this gives: "error: size of array ‘_bool_Var’ is negative", it means that sizeof(*boolPtr)>sizeof(int), which is not allowed */ -- cgit v0.12 From d99970d927187f3d341179fc56c4fe3fcb4cb899 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 2 May 2024 08:41:02 +0000 Subject: Add runtime PANIC when Tcl_GetBoolFromObj() violates size-restrictions, and compile-time checks are disabled with by using -std=c99 --- generic/tclDecls.h | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 5bec80e..7abb1c8 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4032,34 +4032,40 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_GetIndexFromObjStruct #undef Tcl_GetBooleanFromObj #undef Tcl_GetBoolean +#if !defined(TCLBOOLWARNING) #if !defined(__cplusplus) && !defined(BUILD_tcl) && !defined(BUILD_tk) && defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 201112L) # define TCLBOOLWARNING(boolPtr) (void)(sizeof(struct {_Static_assert(sizeof(*(boolPtr)) <= sizeof(int), "sizeof(boolPtr) too large");int dummy;})), -#elif defined(__GNUC__) +#elif defined(__GNUC__) && defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 201112L) /* If this gives: "error: size of array ‘_bool_Var’ is negative", it means that sizeof(*boolPtr)>sizeof(int), which is not allowed */ # define TCLBOOLWARNING(boolPtr) ({__attribute__((unused)) char _bool_Var[sizeof(*(boolPtr)) > sizeof(int) ? -1 : 1];}), #else # define TCLBOOLWARNING(boolPtr) #endif +#endif /* !TCLBOOLWARNING */ #if defined(USE_TCL_STUBS) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ - (TCLBOOLWARNING(boolPtr)(sizeof(*(boolPtr)) >= sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ - Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ + ((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \ + (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))) #define Tcl_GetBoolean(interp, src, boolPtr) \ - (TCLBOOLWARNING(boolPtr)(sizeof(*(boolPtr)) >= sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ - Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ + ((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \ + (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))) #else #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ - (TCLBOOLWARNING(boolPtr)(sizeof(*(boolPtr)) >= sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ - Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ + ((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \ + (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))) #define Tcl_GetBoolean(interp, src, boolPtr) \ - (TCLBOOLWARNING(boolPtr)(sizeof(*(boolPtr)) >= sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ - Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ + ((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \ + (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))) #endif #ifdef TCL_MEM_DEBUG -- cgit v0.12 From 86166e1bf1f380fd197ce96246c9444dc49d0493 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 2 May 2024 09:10:06 +0000 Subject: Would checking for __STRICT_ANSI__ help? --- generic/tclDecls.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 7abb1c8..ed95922 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4035,7 +4035,7 @@ extern const TclStubs *tclStubsPtr; #if !defined(TCLBOOLWARNING) #if !defined(__cplusplus) && !defined(BUILD_tcl) && !defined(BUILD_tk) && defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 201112L) # define TCLBOOLWARNING(boolPtr) (void)(sizeof(struct {_Static_assert(sizeof(*(boolPtr)) <= sizeof(int), "sizeof(boolPtr) too large");int dummy;})), -#elif defined(__GNUC__) && defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 201112L) +#elif defined(__GNUC__) && !defined(__STRICT_ANSI__) /* If this gives: "error: size of array ‘_bool_Var’ is negative", it means that sizeof(*boolPtr)>sizeof(int), which is not allowed */ # define TCLBOOLWARNING(boolPtr) ({__attribute__((unused)) char _bool_Var[sizeof(*(boolPtr)) > sizeof(int) ? -1 : 1];}), #else -- cgit v0.12 From 0780112de30afad9184f79af0866f30577c5d5d5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 2 May 2024 09:22:48 +0000 Subject: Make sure to forward-declare "struct addrinfo". Some compilers don't like doing that in a parameter-list. --- generic/tclInt.h | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclInt.h b/generic/tclInt.h index 3854e0b..5890bcb 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3077,6 +3077,7 @@ MODULE_SCOPE void TclpFinalizeCondition(Tcl_Condition *condPtr); MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr); MODULE_SCOPE void TclpFinalizePipes(void); MODULE_SCOPE void TclpFinalizeSockets(void); +struct addrinfo; /* forward declaration, needed for TclCreateSocketAddress */ MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, struct addrinfo **addrlist, const char *host, int port, int willBind, -- cgit v0.12 From 77146bfc7b8a2300bfee0e0a751f1aaf3918205d Mon Sep 17 00:00:00 2001 From: oehhar Date: Thu, 2 May 2024 09:55:40 +0000 Subject: Ticket [cab08bbf04]: document "format %llu" as invalid --- doc/format.n | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/format.n b/doc/format.n index 1c511e8..16f06c9 100644 --- a/doc/format.n +++ b/doc/format.n @@ -154,6 +154,9 @@ Convert integer to signed decimal string. .TP 10 \fBu\fR Convert integer to unsigned decimal string. +The conversion makes no sense without reference to a truncation range, +so the size modifier \fBll\fR is not permitted in combination +with conversion character \fBu\fR. .TP 10 \fBi\fR Convert integer to signed decimal string (equivalent to \fBd\fR). -- cgit v0.12 From e6b0159de2c46d5f5cd4899188728d7120f059ff Mon Sep 17 00:00:00 2001 From: oehhar Date: Thu, 2 May 2024 09:57:32 +0000 Subject: Ticket [cab08bbf04]: document "scan %llu" as valid --- doc/scan.n | 3 --- 1 file changed, 3 deletions(-) diff --git a/doc/scan.n b/doc/scan.n index 0c24fea..382abb8 100644 --- a/doc/scan.n +++ b/doc/scan.n @@ -117,9 +117,6 @@ The input substring must be a decimal integer. The integer value is truncated as required by the size modifier value, and the corresponding unsigned value for that truncated range is computed and stored in the variable as a decimal string. -The conversion makes no sense without reference to a truncation range, -so the size modifier \fBll\fR is not permitted in combination -with conversion character \fBu\fR. .TP \fBi\fR . -- cgit v0.12 From 823926b42c4f6c2e240279d7bc8d345903a219a6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 2 May 2024 11:12:46 +0000 Subject: Remove COMPAT==0 part, no longer makes sense. More code-cleanup, backported from 8.7 --- generic/tclScan.c | 26 ++++--- generic/tclStringObj.c | 208 +++++++++++++++---------------------------------- 2 files changed, 76 insertions(+), 158 deletions(-) diff --git a/generic/tclScan.c b/generic/tclScan.c index 777deef..2861e0b 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -3,7 +3,7 @@ * * This file contains the implementation of the "scan" command. * - * Copyright (c) 1998 by Scriptics Corporation. + * Copyright (c) 1998 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -340,7 +340,7 @@ ValidateFormat( Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot mix \"%\" and \"%n$\" conversion specifiers", -1)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", (char *)NULL); goto error; } @@ -389,7 +389,7 @@ ValidateFormat( Tcl_SetObjResult(interp, Tcl_NewStringObj( "field width may not be specified in %c conversion", -1)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", (char *)NULL); goto error; } /* FALLTHRU */ @@ -403,7 +403,7 @@ ValidateFormat( Tcl_AppendToObj(errorMsg, buf, -1); Tcl_AppendToObj(errorMsg, " conversion", -1); Tcl_SetObjResult(interp, errorMsg); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", (char *)NULL); goto error; } /* @@ -462,7 +462,7 @@ ValidateFormat( badSet: Tcl_SetObjResult(interp, Tcl_NewStringObj( "unmatched [ in format string", -1)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", (char *)NULL); goto error; default: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; @@ -471,7 +471,7 @@ ValidateFormat( Tcl_AppendToObj(errorMsg, buf, -1); Tcl_AppendToObj(errorMsg, "\"", -1); Tcl_SetObjResult(interp, errorMsg); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", (char *)NULL); goto error; } if (!(flags & SCAN_SUPPRESS)) { @@ -518,7 +518,7 @@ ValidateFormat( Tcl_SetObjResult(interp, Tcl_NewStringObj( "variable is assigned by multiple \"%n$\" conversion specifiers", -1)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", (char *)NULL); goto error; } else if (!xpgSize && (nassign[i] == 0)) { /* @@ -529,7 +529,7 @@ ValidateFormat( Tcl_SetObjResult(interp, Tcl_NewStringObj( "variable is not assigned by any conversion specifiers", -1)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", (char *)NULL); goto error; } } @@ -541,12 +541,12 @@ ValidateFormat( if (gotXpg) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"%n$\" argument index out of range", -1)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", (char *)NULL); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( "different numbers of variable names and field specifiers", -1)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", (char *)NULL); } error: @@ -967,7 +967,7 @@ Tcl_ScanObjCmd( * Scan a floating point number */ - objPtr = Tcl_NewDoubleObj(0.0); + TclNewDoubleObj(objPtr, 0.0); Tcl_IncrRefCount(objPtr); if (width == 0) { width = ~0; @@ -1047,12 +1047,14 @@ Tcl_ScanObjCmd( Tcl_ListObjAppendElement(NULL, objPtr, objs[i]); Tcl_DecrRefCount(objs[i]); } else { + Tcl_Obj *obj; /* * More %-specifiers than matching chars, so we just spit out * empty strings for these. */ - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj()); + TclNewObj(obj); + Tcl_ListObjAppendElement(NULL, objPtr, obj); } } } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index ba02728..dcff811 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -37,16 +37,6 @@ #include "tclInt.h" #include "tommath.h" #include "tclStringRep.h" - -/* - * Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5. - * This is an escape hatch in case the changes have some unexpected unwelcome - * impact on performance. If things go well, this mechanism can go away when - * post-8.6 development begins. - */ - -#define COMPAT 0 - /* * Prototypes for functions defined later in this file: */ @@ -192,7 +182,7 @@ GrowUnicodeBuffer( */ String *ptr = NULL, *stringPtr = GET_STRING(objPtr); - int attempt; + int capacity; if (stringPtr->maxChars > 0) { /* @@ -200,13 +190,13 @@ GrowUnicodeBuffer( */ if (needed <= STRING_MAXCHARS / 2) { - attempt = 2 * needed; - ptr = stringAttemptRealloc(stringPtr, attempt); + capacity = 2 * needed; + ptr = stringAttemptRealloc(stringPtr, capacity); } if (ptr == NULL) { /* * Take care computing the amount of modest growth to avoid - * overflow into invalid argument values for attempt. + * overflow into invalid argument values for capacity. */ unsigned int limit = STRING_MAXCHARS - needed; @@ -214,8 +204,8 @@ GrowUnicodeBuffer( + TCL_MIN_UNICHAR_GROWTH; int growth = (int) ((extra > limit) ? limit : extra); - attempt = needed + growth; - ptr = stringAttemptRealloc(stringPtr, attempt); + capacity = needed + growth; + ptr = stringAttemptRealloc(stringPtr, capacity); } } if (ptr == NULL) { @@ -223,11 +213,11 @@ GrowUnicodeBuffer( * First allocation - just big enough; or last chance fallback. */ - attempt = needed; - ptr = stringRealloc(stringPtr, attempt); + capacity = needed; + ptr = stringRealloc(stringPtr, capacity); } stringPtr = ptr; - stringPtr->maxChars = attempt; + stringPtr->maxChars = capacity; SET_STRING(objPtr, stringPtr); } @@ -274,10 +264,9 @@ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length) /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first NUL - * byte. */ + int length) /* The number of bytes to copy from "bytes" + * when initializing the new object. If negative, + * use bytes up to the first NUL byte. */ { Tcl_Obj *objPtr; @@ -323,10 +312,9 @@ Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length, /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first NUL - * byte. */ + int length, /* The number of bytes to copy from "bytes" + * when initializing the new object. If negative, + * use bytes up to the first NUL byte. */ 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 @@ -459,17 +447,6 @@ Tcl_GetCharLength( TclNumUtfChars(numChars, objPtr->bytes, objPtr->length); stringPtr->numChars = numChars; -#if COMPAT - if (numChars < objPtr->length) { - /* - * Since we've just computed the number of chars, and not all UTF - * chars are 1-byte long, go ahead and populate the Unicode - * string. - */ - - FillUnicodeRep(objPtr); - } -#endif } return numChars; } @@ -540,7 +517,6 @@ Tcl_GetUniChar( int index) /* Get the index'th Unicode character. */ { String *stringPtr; - int length; if (index < 0) { return 0xFFFD; @@ -552,12 +528,13 @@ Tcl_GetUniChar( */ if (TclIsPureByteArray(objPtr)) { + int length; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return 0xFFFD; } - return (Tcl_UniChar) bytes[index]; + return bytes[index]; } /* @@ -599,7 +576,7 @@ TclGetUCS4( int index) /* Get the index'th Unicode character. */ { String *stringPtr; - int ch, length; + int ch; if (index < 0) { return -1; @@ -611,12 +588,13 @@ TclGetUCS4( */ if (TclIsPureByteArray(objPtr)) { + int length; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; } - return (int) bytes[index]; + return bytes[index]; } /* @@ -638,7 +616,6 @@ TclGetUCS4( return -1; } if (stringPtr->numChars == objPtr->length) { - /* Pure ascii, can directly index bytes */ return (unsigned char) objPtr->bytes[index]; } FillUnicodeRep(objPtr); @@ -746,9 +723,9 @@ Tcl_GetUnicodeFromObj( * * Create a Tcl Object that contains the chars between first and last of * the object indicated by "objPtr". If the object is not already a - * String object, convert it to one. If first is negative, the returned - * string start at the beginning of objPtr. If last is negative, the - * returned string ends at the end of objPtr. + * String object, convert it to one. If first is negative, the + * returned string start at the beginning of objPtr. If last is + * negative, the returned string ends at the end of objPtr. * * Results: * Returns a new Tcl Object of the String type. @@ -908,8 +885,7 @@ Tcl_SetStringObj( * * Tcl_SetObjLength -- * - * This function changes the length of the string representation of an - * object. + * Changes the length of the string representation of objPtr. * * Results: * None. @@ -920,8 +896,9 @@ Tcl_SetStringObj( * in the strength. If the length of the string representation is greater * than length, the storage space is reallocated to the given length; a * null byte is stored at the end, but other bytes past the end of the - * original string representation are undefined. The object's internal - * representation is changed to "expendable string". + * original string representation are undefined. + * + * The object's internal representation is changed to &tclStringType. * *---------------------------------------------------------------------- */ @@ -937,11 +914,6 @@ Tcl_SetObjLength( String *stringPtr; if (length < 0) { - /* - * Setting to a negative length is nonsense. This is probably the - * result of overflowing the signed integer range. - */ - Tcl_Panic("Tcl_SetObjLength: negative length requested: " "%d (integer overflow?)", length); } @@ -976,7 +948,7 @@ Tcl_SetObjLength( objPtr->bytes[length] = 0; /* - * Invalidate the unicode data. + * Invalidate the Unicode data. */ stringPtr->numChars = -1; @@ -1042,13 +1014,10 @@ Tcl_AttemptSetObjLength( String *stringPtr; if (length < 0) { - /* - * Setting to a negative length is nonsense. This is probably the - * result of overflowing the signed integer range. - */ - + /* Negative lengths => most likely integer overflow */ return 0; } + if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength"); } @@ -1162,7 +1131,7 @@ UnicodeLength( int numChars = 0; if (unicode) { - while (numChars >= 0 && unicode[numChars] != 0) { + while ((numChars >= 0) && (unicode[numChars] != 0)) { numChars++; } } @@ -1287,7 +1256,7 @@ Tcl_AppendLimitedToObj( } stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode && stringPtr->numChars > 0) { + if (stringPtr->hasUnicode && (stringPtr->numChars > 0)) { AppendUtfToUnicodeRep(objPtr, ellipsis, eLen); } else { AppendUtfToUtfRep(objPtr, ellipsis, eLen); @@ -1366,17 +1335,13 @@ Tcl_AppendUnicodeToObj( * objPtr's string rep. */ - if (stringPtr->hasUnicode -#if COMPAT - && stringPtr->numChars > 0 -#endif - ) { + if (stringPtr->hasUnicode) { AppendUnicodeToUnicodeRep(objPtr, unicode, length); } else { AppendUnicodeToUtfRep(objPtr, unicode, length); } } - + /* *---------------------------------------------------------------------- * @@ -1425,7 +1390,7 @@ Tcl_AppendObjToObj( if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep) && TclIsPureByteArray(appendObjPtr)) { /* - * You might expect the code here to be + * One might expect the code here to be * * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length); * TclAppendBytesToByteArray(objPtr, bytes, length); @@ -1482,11 +1447,7 @@ Tcl_AppendObjToObj( * appendObjPtr and append it. */ - if (stringPtr->hasUnicode -#if COMPAT - && stringPtr->numChars > 0 -#endif - ) { + if (stringPtr->hasUnicode) { /* * If appendObjPtr is not of the "String" type, don't convert it. */ @@ -1520,11 +1481,7 @@ Tcl_AppendObjToObj( AppendUtfToUtfRep(objPtr, bytes, length); - if (numChars >= 0 && appendNumChars >= 0 -#if COMPAT - && appendNumChars == length -#endif - ) { + if ((numChars >= 0) && (appendNumChars >= 0)) { stringPtr->numChars = numChars + appendNumChars; } } @@ -1648,14 +1605,6 @@ AppendUnicodeToUtfRep( if (stringPtr->numChars != -1) { stringPtr->numChars += numChars; } - -#if COMPAT - /* - * Invalidate the Unicode rep. - */ - - stringPtr->hasUnicode = 0; -#endif } /* @@ -1913,8 +1862,8 @@ Tcl_AppendFormatToObj( Tcl_Obj *const objv[]) { const char *span = format, *msg, *errCode; - int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; - int originalLength, limit; + int gotXpg = 0, gotSequential = 0; + int objIndex = 0, originalLength, limit, numBytes = 0; Tcl_UniChar ch = 0; static const char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; @@ -1937,11 +1886,13 @@ Tcl_AppendFormatToObj( while (*format != '\0') { char *end; int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; - int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0; + int gotPrecision, sawFlag, useShort = 0, useBig = 0; + int width, precision; #ifndef TCL_WIDE_INT_IS_LONG int useWide = 0; #endif - int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; + int newXpg, allocSegment = 0; + int numChars, segmentLimit, segmentNumBytes; Tcl_Obj *segment; int step = TclUtfToUniChar(format, &ch); @@ -2298,7 +2249,7 @@ Tcl_AppendFormatToObj( const char *bytes; if (useShort) { - TclNewIntObj(pure, (int) s); + TclNewIntObj(pure, s); #ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { pure = Tcl_NewWideIntObj(w); @@ -2362,9 +2313,10 @@ Tcl_AppendFormatToObj( case 'x': case 'X': case 'b': { - Tcl_WideUInt bits = (Tcl_WideUInt) 0; - Tcl_WideInt numDigits = (Tcl_WideInt) 0; - int length, numBits = 4, base = 16, index = 0, shift = 0; + Tcl_WideUInt bits = 0; + Tcl_WideInt numDigits = 0; + int numBits = 4, base = 16, index = 0, shift = 0; + int length; Tcl_Obj *pure; char *bytes; @@ -2428,9 +2380,9 @@ Tcl_AppendFormatToObj( numDigits = 1; } TclNewObj(pure); - Tcl_SetObjLength(pure, (int) numDigits); + Tcl_SetObjLength(pure, numDigits); bytes = TclGetString(pure); - toAppend = length = (int) numDigits; + toAppend = length = numDigits; while (numDigits--) { int digitOffset; @@ -2442,7 +2394,7 @@ Tcl_AppendFormatToObj( } shift -= numBits; } - digitOffset = (int) (bits % base); + digitOffset = bits % base; if (digitOffset > 9) { if (ch == 'X') { bytes[numDigits] = 'A' + digitOffset - 10; @@ -2565,7 +2517,7 @@ Tcl_AppendFormatToObj( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad field specifier \"%c\"", ch)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", (char *)NULL); } goto error; } @@ -2625,7 +2577,7 @@ Tcl_AppendFormatToObj( errorMsg: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, (char *)NULL); } error: Tcl_SetObjLength(appendObj, originalLength); @@ -2700,7 +2652,8 @@ AppendPrintfToObjVA( const char *format, va_list argList) { - int code, objc; + int code; + int objc; Tcl_Obj **objv, *list; const char *p; @@ -2745,7 +2698,7 @@ AppendPrintfToObjVA( */ q = TclUtfPrev(end, bytes); - if (!Tcl_UtfCharComplete(q, (int)(end - q))) { + if (!Tcl_UtfCharComplete(q, end - q)) { end = q; } @@ -2756,7 +2709,7 @@ AppendPrintfToObjVA( } Tcl_ListObjAppendElement(NULL, list, - Tcl_NewStringObj(bytes , (int)(end - bytes))); + Tcl_NewStringObj(bytes , end - bytes)); break; } @@ -2771,8 +2724,8 @@ AppendPrintfToObjVA( switch (size) { case -1: case 0: - Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( - (long)va_arg(argList, int))); + Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj( + va_arg(argList, int))); break; case 1: Tcl_ListObjAppendElement(NULL, list, NewLongObj(*p, @@ -2790,7 +2743,7 @@ AppendPrintfToObjVA( seekingConversion = 0; break; case '*': - lastNum = (int) va_arg(argList, int); + lastNum = va_arg(argList, int); Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum)); p++; break; @@ -2798,7 +2751,7 @@ AppendPrintfToObjVA( case '5': case '6': case '7': case '8': case '9': { char *end; - lastNum = (int) strtoul(p, &end, 10); + lastNum = strtoul(p, &end, 10); p = end; break; } @@ -3191,14 +3144,12 @@ DupStringInternalRep( String *srcStringPtr = GET_STRING(srcPtr); String *copyStringPtr = NULL; -#if COMPAT==0 if (srcStringPtr->numChars == -1) { /* * The String struct in the source value holds zero useful data. Don't * bother copying it. Don't even bother allocating space in which to * copy it. Just let the copy be untyped. */ - return; } @@ -3234,41 +3185,6 @@ DupStringInternalRep( */ copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0; -#else /* COMPAT!=0 */ - /* - * If the src obj is a string of 1-byte Utf chars, then copy the string - * rep of the source object and create an "empty" Unicode internal rep for - * the new object. Otherwise, copy Unicode internal rep, and invalidate - * the string rep of the new object. - */ - - if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) { - /* - * Copy the full allocation for the Unicode buffer. - */ - - copyStringPtr = stringAlloc(srcStringPtr->maxChars); - copyStringPtr->maxChars = srcStringPtr->maxChars; - memcpy(copyStringPtr->unicode, srcStringPtr->unicode, - srcStringPtr->numChars * sizeof(Tcl_UniChar)); - copyStringPtr->unicode[srcStringPtr->numChars] = 0; - copyStringPtr->allocated = 0; - } else { - copyStringPtr = stringAlloc(0); - copyStringPtr->unicode[0] = 0; - copyStringPtr->maxChars = 0; - - /* - * Tricky point: the string value was copied by generic object - * management code, so it doesn't contain any extra bytes that might - * exist in the source object. - */ - - copyStringPtr->allocated = copyPtr->length; - } - copyStringPtr->numChars = srcStringPtr->numChars; - copyStringPtr->hasUnicode = srcStringPtr->hasUnicode; -#endif /* COMPAT==0 */ SET_STRING(copyPtr, copyStringPtr); copyPtr->typePtr = &tclStringType; @@ -3286,7 +3202,7 @@ DupStringInternalRep( * * Side effects: * Any old internal representation for objPtr is freed and the internal - * representation is set to "String". + * representation is set to &tclStringType. * *---------------------------------------------------------------------- */ -- cgit v0.12 From c7e0c0c16e0cedb793543a8b484a9b16cca290c6 Mon Sep 17 00:00:00 2001 From: mjanssen Date: Thu, 2 May 2024 21:29:19 +0000 Subject: [unknown] only calls shell command in interactive tclsh sessions --- doc/unknown.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/unknown.n b/doc/unknown.n index ee8a5be..8ea1e8e 100644 --- a/doc/unknown.n +++ b/doc/unknown.n @@ -47,7 +47,7 @@ The default implementation of \fBunknown\fR behaves as follows. It first calls the \fBauto_load\fR library procedure to load the command. If this succeeds, then it executes the original command with its original arguments. -If the auto-load fails then \fBunknown\fR calls \fBauto_execok\fR +If the auto-load fails and Tcl is run interactively then \fBunknown\fR calls \fBauto_execok\fR to see if there is an executable file by the name \fIcmd\fR. If so, it invokes the Tcl \fBexec\fR command with \fIcmd\fR and all the \fIargs\fR as arguments. -- cgit v0.12 From 08580d159a5b5112b72eecae5a1a7dff2abdfb3f Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 3 May 2024 16:23:22 +0000 Subject: Fix [a5f4a7aed8] - tcl::tm::path auto_index entry --- library/tclIndex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/tclIndex b/library/tclIndex index 2d4a957..871298f 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -95,7 +95,7 @@ set auto_index(::safe::RejectExcessColons) [list ::tcl::Pkg::source [file join $ set auto_index(::safe::VarName) [list ::tcl::Pkg::source [file join $dir safe.tcl]] set auto_index(::safe::Setup) [list ::tcl::Pkg::source [file join $dir safe.tcl]] set auto_index(::safe::setSyncMode) [list ::tcl::Pkg::source [file join $dir safe.tcl]] -set auto_index(::tcl::tmpath) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::path) [list ::tcl::Pkg::source [file join $dir tm.tcl]] set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]] set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]] set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]] -- cgit v0.12 From 8752bdd01afda74956e2c3b814b4c3d64acc93c0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 4 May 2024 16:12:42 +0000 Subject: [unknown] only calls shell command in interactive tclsh sessions --- doc/unknown.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/unknown.n b/doc/unknown.n index 82dcefc..408ebc1 100644 --- a/doc/unknown.n +++ b/doc/unknown.n @@ -47,7 +47,7 @@ The default implementation of \fBunknown\fR behaves as follows. It first calls the \fBauto_load\fR library procedure to load the command. If this succeeds, then it executes the original command with its original arguments. -If the auto-load fails then \fBunknown\fR calls \fBauto_execok\fR +If the auto-load fails and Tcl is run interactively then \fBunknown\fR calls \fBauto_execok\fR to see if there is an executable file by the name \fIcmd\fR. If so, it invokes the Tcl \fBexec\fR command with \fIcmd\fR and all the \fIargs\fR as arguments. -- cgit v0.12 From 3c22b99c8b39c0758ecf89bf7369191103582a7a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 4 May 2024 16:17:32 +0000 Subject: Fix [a5f4a7aed8] - tcl::tm::path auto_index entry --- library/tclIndex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/tclIndex b/library/tclIndex index 9784265..88a7bc0 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -67,7 +67,7 @@ set auto_index(::safe::AliasExeName) [list source -encoding utf-8 [file join $di set auto_index(::safe::RejectExcessColons) [list source -encoding utf-8 [file join $dir safe.tcl]] set auto_index(::safe::VarName) [list source -encoding utf-8 [file join $dir safe.tcl]] set auto_index(::safe::Setup) [list source -encoding utf-8 [file join $dir safe.tcl]] -set auto_index(::tcl::tmpath) [list source -encoding utf-8 [file join $dir tm.tcl]] +set auto_index(::tcl::tm::path) [list source -encoding utf-8 [file join $dir tm.tcl]] set auto_index(::tcl::tm::add) [list source -encoding utf-8 [file join $dir tm.tcl]] set auto_index(::tcl::tm::remove) [list source -encoding utf-8 [file join $dir tm.tcl]] set auto_index(::tcl::tm::list) [list source -encoding utf-8 [file join $dir tm.tcl]] -- cgit v0.12 From 9788573839698900297978ac52c242cf1403fd4e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 4 May 2024 18:53:14 +0000 Subject: Possible solution for [3c26dec71e]: TCLX_y_TM_PATH - unspecified behaviour - change with 90b1rc --- library/tm.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/tm.tcl b/library/tm.tcl index 96bfe03..08afd4d 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -97,7 +97,7 @@ proc ::tcl::tm::add {args} { set newpaths $paths foreach p $args { - if {$p in $newpaths} { + if {($p eq "") || ($p in $newpaths)} { # Ignore a path already on the list. continue } -- cgit v0.12 From 14c8708b6524c0d21f4bcf0b755cc86e29a1bb35 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 7 May 2024 19:04:29 +0000 Subject: closes [a858d95f4bfddafb]: adjust word-token pointer after possible realloc --- generic/tclClockFmt.c | 2 ++ tests/clock.test | 8 ++++++++ 2 files changed, 10 insertions(+) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 154c8ee..fdac4fb 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -2307,6 +2307,7 @@ ClockGetOrParseScanFormat( wordTok->tokWord.start = p; wordTok->map = &ScnWordTokenMap; AllocTokenInChain(tok, scnTok, fss->scnTokC, ClockScanToken *); + wordTok = tok - 1; tokCnt++; } if (isspace(UCHAR(*p))) { @@ -3344,6 +3345,7 @@ ClockGetOrParseFmtFormat( wordTok->tokWord.start = p; wordTok->map = &FmtWordTokenMap; AllocTokenInChain(tok, fmtTok, fss->fmtTokC, ClockFormatToken *); + wordTok = tok - 1; tokCnt++; } p = Tcl_UtfNext(p); diff --git a/tests/clock.test b/tests/clock.test index 8072a68..ef41ad5 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -375,6 +375,10 @@ test clock-1.9 "clock arguments: option doubly present" { list [catch {clock format 0 -gmt 1 -gmt 0} result] $result } {1 {bad option "-gmt": doubly present}} +test clock-1.10 {clock format: text with token (bug [a858d95f4bfddafb])} { + clock format 0 -format text(%d) -gmt 1 +} {text(01)} + # BEGIN testcases2 # Test formatting of Gregorian year, month, day, all formats @@ -18924,6 +18928,10 @@ test clock-6.22.20 {Greedy match (second space wins as date-time separator)} { clock format [clock scan "111 2 13120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1 } {Sun Jan 02 13:12:00 GMT 2011} +test clock-6.23 {clock scan: text with token (bug [a858d95f4bfddafb])} { + clock scan {text(01)} -format text(%d) -gmt 1 -base 0 +} 0 + test clock-7.1 {Julian Day} { clock scan 0 -format %J -gmt true -- cgit v0.12 From 550e07034cc781c7cc5a15e5dd5977c8f9be16c8 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 7 May 2024 20:09:14 +0000 Subject: code review (optimization by parse of word tokens in clock format) --- generic/tclClockFmt.c | 67 +++++++++++++++++++++++++++------------------------ 1 file changed, 36 insertions(+), 31 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index fdac4fb..b08dc72 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -2139,16 +2139,13 @@ EstimateTokenCount( return ++tokcnt; } -#define AllocTokenInChain(tok, chain, tokCnt, type) \ - if (++(tok) >= (chain) + (tokCnt)) { \ - chain = (type)attemptckrealloc((char *)(chain), \ +#define AllocTokenInChain(tok, chain, tokCnt, type) \ + if (++(tok) >= (chain) + (tokCnt)) { \ + chain = (type)ckrealloc((char *)(chain), \ (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \ - if ((chain) == NULL) { \ - goto done; \ - } \ - (tok) = (chain) + (tokCnt); \ - (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ - } \ + (tok) = (chain) + (tokCnt); \ + (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ + } \ memset(tok, 0, sizeof(*(tok))); /* @@ -2281,7 +2278,7 @@ ClockGetOrParseScanFormat( continue; } default: - if (*p == ' ' || isspace(UCHAR(*p))) { + if (isspace(UCHAR(*p))) { tok->map = &ScnSpaceTokenMap; tok->tokWord.start = p++; while (p < e && isspace(UCHAR(*p))) { @@ -2295,29 +2292,34 @@ ClockGetOrParseScanFormat( tokCnt++; continue; } - word_tok: - { + word_tok: + { ClockScanToken *wordTok = tok; if (tok > scnTok && (tok - 1)->map == &ScnWordTokenMap) { + /* further with previous word token */ wordTok = tok - 1; - } - /* new word token */ - if (wordTok == tok) { + } else { + /* new word token */ wordTok->tokWord.start = p; wordTok->map = &ScnWordTokenMap; + } + + do { + if (isspace(UCHAR(*p))) { + fss->scnSpaceCount++; + } + p = Tcl_UtfNext(p); + } while (p < e && *p != '%'); + wordTok->tokWord.end = p; + + if (wordTok == tok) { AllocTokenInChain(tok, scnTok, fss->scnTokC, ClockScanToken *); - wordTok = tok - 1; tokCnt++; } - if (isspace(UCHAR(*p))) { - fss->scnSpaceCount++; } - p = Tcl_UtfNext(p); - wordTok->tokWord.end = p; break; } - } } /* calculate end distance value for each tokens */ @@ -2349,9 +2351,8 @@ ClockGetOrParseScanFormat( fss->scnTok = scnTok; fss->scnTokC = tokCnt; } - done: - Tcl_MutexUnlock(&ClockFmtMutex); + Tcl_MutexUnlock(&ClockFmtMutex); return fss; } @@ -3335,24 +3336,28 @@ ClockGetOrParseFmtFormat( continue; } default: - word_tok: { + word_tok: + { ClockFormatToken *wordTok = tok; if (tok > fmtTok && (tok - 1)->map == &FmtWordTokenMap) { wordTok = tok - 1; - } - if (wordTok == tok) { + } else { wordTok->tokWord.start = p; wordTok->map = &FmtWordTokenMap; + } + do { + p = Tcl_UtfNext(p); + } while (p < e && *p != '%'); + wordTok->tokWord.end = p; + + if (wordTok == tok) { AllocTokenInChain(tok, fmtTok, fss->fmtTokC, ClockFormatToken *); - wordTok = tok - 1; tokCnt++; } - p = Tcl_UtfNext(p); - wordTok->tokWord.end = p; + } break; } - } } /* correct count of real used tokens and free mem if desired @@ -3368,7 +3373,7 @@ ClockGetOrParseFmtFormat( fss->fmtTok = fmtTok; fss->fmtTokC = tokCnt; } - done: + Tcl_MutexUnlock(&ClockFmtMutex); return fss; } -- cgit v0.12 From f3468cae606bfbd60d59712700d5635fe0a145ce Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 7 May 2024 20:45:54 +0000 Subject: more simplifications --- generic/tclClockFmt.c | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index b08dc72..392574c 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -2294,13 +2294,12 @@ ClockGetOrParseScanFormat( } word_tok: { - ClockScanToken *wordTok = tok; + /* try continue with previous word token */ + ClockScanToken *wordTok = tok - 1; - if (tok > scnTok && (tok - 1)->map == &ScnWordTokenMap) { - /* further with previous word token */ - wordTok = tok - 1; - } else { - /* new word token */ + if (wordTok < scnTok || wordTok->map != &ScnWordTokenMap) { + /* start with new word token */ + wordTok = tok; wordTok->tokWord.start = p; wordTok->map = &ScnWordTokenMap; } @@ -3338,11 +3337,12 @@ ClockGetOrParseFmtFormat( default: word_tok: { - ClockFormatToken *wordTok = tok; + /* try continue with previous word token */ + ClockFormatToken *wordTok = tok - 1; - if (tok > fmtTok && (tok - 1)->map == &FmtWordTokenMap) { - wordTok = tok - 1; - } else { + if (wordTok < fmtTok || wordTok->map != &FmtWordTokenMap) { + /* start with new word token */ + wordTok = tok; wordTok->tokWord.start = p; wordTok->map = &FmtWordTokenMap; } -- cgit v0.12 From 91381ba59308b1df598247eaf2c19fe150264023 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 8 May 2024 09:03:58 +0000 Subject: Cleaning up tclWinSock.c --- win/tclWinSock.c | 314 ++++++++++++++++++++++++++++++------------------------- 1 file changed, 169 insertions(+), 145 deletions(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index c51d69d..70cf6ab 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -62,10 +62,10 @@ #define SET_BITS(var, bits) ((var) |= (bits)) #define CLEAR_BITS(var, bits) ((var) &= ~(bits)) -#define GOT_BITS(var, bits) (((var) & (bits)) != 0) +#define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ -#define SOCK_CHAN_LENGTH (16 + TCL_INTEGER_SPACE) +#define SOCK_CHAN_LENGTH (16 + TCL_INTEGER_SPACE) /* * The following variable is used to tell whether this module has been @@ -80,12 +80,19 @@ TCL_DECLARE_MUTEX(socketMutex) /* * The following defines declare the messages used on socket windows. */ +enum TclSocketMessages { + SOCKET_MESSAGE = WM_USER+1, /* Sent by OS: something happened. */ + SOCKET_SELECT = WM_USER+2, /* Adjust select mask. */ + SOCKET_TERMINATE = WM_USER+3/* Stop worker thread. */ +}; -#define SOCKET_MESSAGE WM_USER+1 -#define SOCKET_SELECT WM_USER+2 -#define SOCKET_TERMINATE WM_USER+3 -#define SELECT TRUE -#define UNSELECT FALSE +/* + * Operations used with a SOCKET_SELECT message. + */ +enum SocketSelectOperations { + SELECT = TRUE, /* Add socket to select. */ + UNSELECT = FALSE /* Remove socket from select. */ +}; /* * This is needed to comply with the strict aliasing rules of GCC, but it also @@ -150,7 +157,7 @@ struct TcpState { struct addrinfo *myaddrlist;/* Local address. */ struct addrinfo *myaddr; /* Iterator over myaddrlist. */ int connectError; /* Cache status of async socket. */ - int cachedBlocking; /* Cache blocking mode of async socket. */ + int cachedBlocking; /* Cache blocking mode of async socket. */ volatile int notifierConnectError; /* Async connect error set by notifier thread. * This error is still a windows error code. @@ -164,21 +171,20 @@ struct TcpState { * structure. */ -#define TCP_NONBLOCKING (1<<0) /* Socket with non-blocking I/O */ -#define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */ -#define SOCKET_EOF (1<<2) /* A zero read happened on the - * socket. */ -#define SOCKET_PENDING (1<<3) /* A message has been sent for this - * socket */ -#define TCP_ASYNC_PENDING (1<<4) /* TcpConnect was called to - * process an async connect. This - * flag indicates that reentry is - * still pending */ -#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */ - -#define TCP_ASYNC_TEST_MODE (1<<8) /* Async testing activated. Do not - * automatically continue connection - * process */ +enum TcpStateFlags { + TCP_NONBLOCKING = (1<<0), /* Socket with non-blocking I/O. */ + TCP_ASYNC_CONNECT = (1<<1), /* Async connect in progress. */ + SOCKET_EOF = (1<<2), /* A zero read happened on the socket. */ + SOCKET_PENDING = (1<<3), /* A message has been sent for this socket */ + TCP_ASYNC_PENDING = (1<<4), /* TcpConnect was called to process an async + * connect. This flag indicates that reentry is + * still pending. */ + TCP_ASYNC_FAILED = (1<<5), /* An async connect finally failed. */ + + TCP_ASYNC_TEST_MODE = (1<<8)/* Async testing activated. Do not + * automatically continue connection + * process */ +}; /* * The following structure is what is added to the Tcl event queue when a @@ -201,7 +207,10 @@ typedef struct { #define TCP_BUFFER_SIZE 4096 - +/* + * Per (main) thread data, holding list of things being waited upon and the + * various handles to things doing the waiting/notification. + */ typedef struct { HWND hwnd; /* Handle to window for socket messages. */ HANDLE socketThread; /* Thread handling the window */ @@ -211,8 +220,7 @@ typedef struct { * socketThread has been initialized and has * started. */ HANDLE socketListLock; /* Win32 Event to lock the socketList */ - TcpState *pendingTcpState; - /* This socket is opened but not jet in the + TcpState *pendingTcpState; /* This socket is opened but not jet in the * list. This value is also checked by * the event structure. */ TcpState *socketList; /* Every open socket in this thread has an @@ -237,7 +245,7 @@ static void TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr); static int WaitForConnect(TcpState *statePtr, int *errorCodePtr); static int WaitForSocketEvent(TcpState *statePtr, int events, int *errorCodePtr); -static void AddSocketInfoFd(TcpState *statePtr, SOCKET socket); +static void AddSocketInfoFd(TcpState *statePtr, SOCKET socket); static int FindFDInList(TcpState *statePtr, SOCKET socket); static DWORD WINAPI SocketThread(LPVOID arg); static void TcpThreadActionProc(void *instanceData, @@ -264,7 +272,7 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc; static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Old close proc. Deprecated. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -272,7 +280,7 @@ static const Tcl_ChannelType tcpChannelType = { TcpGetOptionProc, /* Get option proc. */ TcpWatchProc, /* Initialize notifier. */ TcpGetHandleProc, /* Get OS handles out of channel. */ - TcpClose2Proc, /* Close2 proc. */ + TcpClose2Proc, /* New close2 proc. */ TcpBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ @@ -288,21 +296,32 @@ static const Tcl_ChannelType tcpChannelType = { static TclInitProcessGlobalValueProc InitializeHostName; static ProcessGlobalValue hostName = {0, 0, NULL, NULL, InitializeHostName, NULL, NULL}; - + /* - * Simple wrapper round the SendMessage syscall. + *---------------------------------------------------------------------- + * + * SendSelectMessage -- + * + * Simple wrapper round the SendMessage syscall with a SOCKET_SELECT + * message to add a bit of type safety. + * + *---------------------------------------------------------------------- */ - -#define SendSelectMessage(tsdPtr, message, payload) \ - SendMessageW((tsdPtr)->hwnd, SOCKET_SELECT, \ - (WPARAM) (message), (LPARAM) (payload)) - +static inline void +SendSelectMessage( + ThreadSpecificData *tsdPtr, /* Reference to this thread's worker. */ + int operation, /* Whether to add or remove from the mask. */ + TcpState *payload) /* What socket to add/remove. */ +{ + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) operation, + (LPARAM) payload); +} /* * Address print debug functions */ #if 0 -void +static inline void printaddrinfo( struct addrinfo *ai, char *prefix) @@ -311,10 +330,10 @@ printaddrinfo( getnameinfo(ai->ai_addr, ai->ai_addrlen, host, sizeof(host), port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); + NI_NUMERICHOST | NI_NUMERICSERV); } -void +static void printaddrinfolist( struct addrinfo *addrlist, char *prefix) @@ -348,17 +367,17 @@ InitializeHostName( Tcl_Encoding *encodingPtr) { WCHAR wbuf[256]; - DWORD length = sizeof(wbuf)/sizeof(WCHAR); + DWORD length = sizeof(wbuf) / sizeof(WCHAR); Tcl_DString ds; Tcl_DStringInit(&ds); - if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) { + if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, + &length) != 0) { /* * Convert string from native to UTF then change to lowercase. */ Tcl_UtfToLower(Tcl_WCharToUtfDString(wbuf, TCL_INDEX_NONE, &ds)); - } else { TclInitSockets(); /* @@ -380,7 +399,7 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); - *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); + *valuePtr = (char *) Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); Tcl_DStringFree(&ds); } @@ -414,8 +433,8 @@ Tcl_GetHostName(void) * * TclInitSockets -- * - * Initialization of sockets for the thread. Also creates message - * handling window class for the process if needed. + * Initialization of sockets for the thread. Also creates message + * handling window class for the process if needed. * * Results: * Nothing. Panics on failure. @@ -433,7 +452,8 @@ TclInitSockets(void) { /* Then Per thread initialization. */ DWORD id; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { return; @@ -449,10 +469,10 @@ TclInitSockets(void) tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->pendingTcpState = NULL; - tsdPtr->socketList = NULL; - tsdPtr->hwnd = NULL; - tsdPtr->threadId = Tcl_GetCurrentThread(); - tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); + tsdPtr->socketList = NULL; + tsdPtr->hwnd = NULL; + tsdPtr->threadId = Tcl_GetCurrentThread(); + tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); if (tsdPtr->readyEvent == NULL) { goto initFailure; } @@ -507,7 +527,8 @@ TclInitSockets(void) void TclpFinalizeSockets(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Careful! This is a finalizer! @@ -562,12 +583,12 @@ TclpFinalizeSockets(void) static int TcpBlockModeProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { - TcpState *statePtr = (TcpState *)instanceData; + TcpState *statePtr = (TcpState *) instanceData; if (mode == TCL_MODE_NONBLOCKING) { SET_BITS(statePtr->flags, TCP_NONBLOCKING); @@ -616,7 +637,6 @@ WaitForConnect( { int result; int oldMode; - ThreadSpecificData *tsdPtr; /* * Check if an async connect failed already and error reporting is @@ -646,7 +666,7 @@ WaitForConnect( if (GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE) && errorCodePtr != NULL - && GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { + && GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { *errorCodePtr = EWOULDBLOCK; return -1; } @@ -666,7 +686,8 @@ WaitForConnect( * Get the statePtr lock. */ - tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* @@ -739,11 +760,11 @@ WaitForConnect( return -1; } - /* - * Free list lock. - */ + /* + * Free list lock. + */ - SetEvent(tsdPtr->socketListLock); + SetEvent(tsdPtr->socketListLock); /* * Background operation returns with no action as there was no connect @@ -793,7 +814,7 @@ WaitForConnect( static int TcpInputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -802,7 +823,8 @@ TcpInputProc( TcpState *statePtr = (TcpState *)instanceData; int bytesRead; DWORD error; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; @@ -884,7 +906,7 @@ TcpInputProc( */ if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING) - || (error != WSAEWOULDBLOCK)) { + || (error != WSAEWOULDBLOCK)) { Tcl_WinConvertError(error); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; @@ -926,7 +948,7 @@ TcpInputProc( static int TcpOutputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ @@ -934,7 +956,8 @@ TcpOutputProc( TcpState *statePtr = (TcpState *)instanceData; int written; DWORD error; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; @@ -1030,7 +1053,7 @@ TcpOutputProc( static int TcpCloseProc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ TCL_UNUSED(Tcl_Interp *)) { TcpState *statePtr = (TcpState *)instanceData; @@ -1056,10 +1079,10 @@ TcpCloseProc( } if (statePtr->addrlist != NULL) { - freeaddrinfo(statePtr->addrlist); + freeaddrinfo(statePtr->addrlist); } if (statePtr->myaddrlist != NULL) { - freeaddrinfo(statePtr->myaddrlist); + freeaddrinfo(statePtr->myaddrlist); } /* @@ -1116,7 +1139,7 @@ TcpCloseProc( static int TcpClose2Proc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { @@ -1128,7 +1151,7 @@ TcpClose2Proc( * Shutdown the OS socket handle. */ - if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) { return TcpCloseProc(instanceData, interp); } @@ -1137,11 +1160,13 @@ TcpClose2Proc( * TCL_WRITABLE so this should never be called for a server socket. */ - if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) { + if ((flags & TCL_CLOSE_READ) + && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) { Tcl_WinConvertError((DWORD) WSAGetLastError()); readError = Tcl_GetErrno(); } - if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) { + if ((flags & TCL_CLOSE_WRITE) + && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) { Tcl_WinConvertError((DWORD) WSAGetLastError()); writeError = Tcl_GetErrno(); } @@ -1166,7 +1191,7 @@ TcpClose2Proc( static int TcpSetOptionProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Name of the option to set. */ const char *value) /* New value for option. */ @@ -1249,7 +1274,7 @@ TcpSetOptionProc( static int TcpGetOptionProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Name of the option to retrieve the value * for, or NULL to get all options and their @@ -1263,6 +1288,9 @@ TcpGetOptionProc( size_t len = 0; int reverseDNS = 0; #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" +#define HAVE_OPTION(option) \ + ((len > 1) && (optionName[1] == option[1]) && \ + (strncmp(optionName, option, len) == 0)) /* * Go one step in async connect @@ -1280,8 +1308,7 @@ TcpGetOptionProc( len = strlen(optionName); } - if ((len > 1) && (optionName[1] == 'e') && - (strncmp(optionName, "-error", len) == 0)) { + if (HAVE_OPTION("-error")) { /* * Do not return any errors if async connect is running. */ @@ -1296,7 +1323,8 @@ TcpGetOptionProc( if (statePtr->connectError != 0) { Tcl_DStringAppend(dsPtr, - Tcl_ErrnoMsg(statePtr->connectError), TCL_INDEX_NONE); + Tcl_ErrnoMsg(statePtr->connectError), + TCL_INDEX_NONE); statePtr->connectError = 0; } } else { @@ -1331,19 +1359,19 @@ TcpGetOptionProc( if (err) { Tcl_WinConvertError(err); - Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), TCL_INDEX_NONE); + Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), + TCL_INDEX_NONE); } } } return TCL_OK; } - if ((len > 1) && (optionName[1] == 'c') && - (strncmp(optionName, "-connecting", len) == 0)) { + if (HAVE_OPTION("-connecting")) { Tcl_DStringAppend(dsPtr, GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING) ? "1" : "0", TCL_INDEX_NONE); - return TCL_OK; + return TCL_OK; } if (interp != NULL @@ -1351,8 +1379,7 @@ TcpGetOptionProc( reverseDNS = NI_NUMERICHOST; } - if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && - (strncmp(optionName, "-peername", len) == 0))) { + if (HAVE_OPTION("-peername")) { address peername; socklen_t size = sizeof(peername); @@ -1410,8 +1437,7 @@ TcpGetOptionProc( } } - if ((len == 0) || ((len > 1) && (optionName[1] == 's') && - (strncmp(optionName, "-sockname", len) == 0))) { + if ((len == 0) || HAVE_OPTION("-sockname")) { TcpFdList *fds; address sockname; socklen_t size; @@ -1483,8 +1509,7 @@ TcpGetOptionProc( } } - if ((len == 0) || ((len > 1) && (optionName[1] == 'k') && - (strncmp(optionName, "-keepalive", len) == 0))) { + if ((len == 0) || HAVE_OPTION("-keepalive")) { int optlen; BOOL opt = FALSE; @@ -1500,8 +1525,7 @@ TcpGetOptionProc( } } - if ((len == 0) || ((len > 1) && (optionName[1] == 'n') && - (strncmp(optionName, "-nodelay", len) == 0))) { + if ((len == 0) || HAVE_OPTION("-nodelay")) { int optlen; BOOL opt = FALSE; @@ -1545,7 +1569,7 @@ TcpGetOptionProc( static void TcpWatchProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1599,9 +1623,9 @@ TcpWatchProc( static int TcpGetHandleProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { TcpState *statePtr = (TcpState *)instanceData; @@ -1623,9 +1647,9 @@ TcpGetHandleProc( * connect synchronously * * Results: - * TCL_OK, if the socket was successfully connected or an asynchronous - * connection is in progress. If an error occurs, TCL_ERROR is returned - * and an error message is left in interp. + * TCL_OK, if the socket was successfully connected or an asynchronous + * connection is in progress. If an error occurs, TCL_ERROR is returned + * and an error message is left in interp. * * Side effects: * Opens a socket. @@ -1652,16 +1676,17 @@ TcpConnect( { DWORD error; int async_connect = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT); - /* We are started with async connect and the - * connect notification was not yet - * received. */ + /* We are started with async connect and the + * connect notification was not yet + * received. */ int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING); - /* We were called by the event procedure and - * continue our loop. */ - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + /* We were called by the event procedure and + * continue our loop. */ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); if (async_callback) { - goto reenter; + goto reenter; } for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL; @@ -1678,10 +1703,10 @@ TcpConnect( continue; } - /* - * Close the socket if it is still open from the last unsuccessful - * iteration. - */ + /* + * Close the socket if it is still open from the last unsuccessful + * iteration. + */ if (statePtr->sockets->fd != INVALID_SOCKET) { closesocket(statePtr->sockets->fd); @@ -1994,16 +2019,16 @@ Tcl_OpenTcpClient( */ if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg) - || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, - &errorMsg)) { - if (addrlist != NULL) { - freeaddrinfo(addrlist); - } - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", errorMsg)); - } - return NULL; + || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, + &errorMsg)) { + if (addrlist != NULL) { + freeaddrinfo(addrlist); + } + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open socket: %s", errorMsg)); + } + return NULL; } statePtr = NewSocketInfo(INVALID_SOCKET); @@ -2056,13 +2081,10 @@ Tcl_Channel Tcl_MakeTcpClientChannel( void *sock) /* The socket to wrap up into a channel. */ { - TcpState *statePtr; - char channelName[SOCK_CHAN_LENGTH]; - ThreadSpecificData *tsdPtr; - TclInitSockets(); - tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Set kernel space buffering and non-blocking. @@ -2070,7 +2092,7 @@ Tcl_MakeTcpClientChannel( TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE); - statePtr = NewSocketInfo((SOCKET) sock); + TcpState *statePtr = NewSocketInfo((SOCKET) sock); /* * Start watching for read/write events on the socket. @@ -2079,6 +2101,7 @@ Tcl_MakeTcpClientChannel( statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; SendSelectMessage(tsdPtr, SELECT, statePtr); + char channelName[SOCK_CHAN_LENGTH]; TclWinGenerateChannelName(channelName, "sock", statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, (TCL_READABLE | TCL_WRITABLE)); @@ -2109,8 +2132,8 @@ Tcl_OpenTcpServerEx( const char *service, /* Port number to open. */ const char *myHost, /* Name of local host. */ unsigned int flags, /* Flags. */ - int backlog, /* Length of OS listen backlog queue, or -1 - * for default. */ + int backlog, /* Length of OS listen backlog queue, or -1 + * for default. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ @@ -2144,7 +2167,7 @@ Tcl_OpenTcpServerEx( for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) { sock = socket(addrPtr->ai_family, addrPtr->ai_socktype, - addrPtr->ai_protocol); + addrPtr->ai_protocol); if (sock == INVALID_SOCKET) { Tcl_WinConvertError((DWORD) WSAGetLastError()); continue; @@ -2221,9 +2244,9 @@ Tcl_OpenTcpServerEx( * different, and there may be differences between TCP/IP stacks). */ - if (backlog < 0) { - backlog = SOMAXCONN; - } + if (backlog < 0) { + backlog = SOMAXCONN; + } if (listen(sock, backlog) == SOCKET_ERROR) { Tcl_WinConvertError((DWORD) WSAGetLastError()); closesocket(sock); @@ -2247,7 +2270,8 @@ Tcl_OpenTcpServerEx( } if (statePtr != NULL) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; @@ -2276,7 +2300,7 @@ Tcl_OpenTcpServerEx( } if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open socket: %s", (errorMsg ? errorMsg : Tcl_PosixError(interp)))); } @@ -2314,7 +2338,8 @@ TcpAccept( int len = sizeof(addr); char channelName[SOCK_CHAN_LENGTH]; char host[NI_MAXHOST], port[NI_MAXSERV]; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Win-NT has a misfeature that sockets are inherited in child processes @@ -2541,9 +2566,9 @@ SocketCheckProc( statePtr = statePtr->nextPtr) { if (GOT_BITS(statePtr->readyEvents, statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) - && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { + && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { SET_BITS(statePtr->flags, SOCKET_PENDING); - evPtr = (SocketEvent *)Tcl_Alloc(sizeof(SocketEvent)); + evPtr = (SocketEvent *) Tcl_Alloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; evPtr->socket = statePtr->sockets->fd; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -2609,7 +2634,7 @@ SocketEventProc( */ if (!statePtr) { - SetEvent(tsdPtr->socketListLock); + SetEvent(tsdPtr->socketListLock); return 1; } @@ -2818,7 +2843,7 @@ AddSocketInfoFd( * Add the first FD. */ - statePtr->sockets = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); + statePtr->sockets = (TcpFdList *) Tcl_Alloc(sizeof(TcpFdList)); fds = statePtr->sockets; } else { /* @@ -2829,7 +2854,7 @@ AddSocketInfoFd( fds = fds->next; } - fds->next = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); + fds->next = (TcpFdList *) Tcl_Alloc(sizeof(TcpFdList)); fds = fds->next; } @@ -2841,8 +2866,7 @@ AddSocketInfoFd( fds->statePtr = statePtr; fds->next = NULL; } - - + /* *---------------------------------------------------------------------- * @@ -2860,9 +2884,10 @@ AddSocketInfoFd( */ static TcpState * -NewSocketInfo(SOCKET socket) +NewSocketInfo( + SOCKET socket) { - TcpState *statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); + TcpState *statePtr = (TcpState *) Tcl_Alloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); @@ -2897,15 +2922,15 @@ NewSocketInfo(SOCKET socket) static int WaitForSocketEvent( - TcpState *statePtr, /* Information about this socket. */ + TcpState *statePtr, /* Information about this socket. */ int events, /* Events to look for. May be one of - * FD_READ or FD_WRITE. - */ + * FD_READ or FD_WRITE. */ int *errorCodePtr) /* Where to store errors? */ { int result = 1; int oldMode; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Be sure to disable event servicing so we are truly modal. @@ -3032,7 +3057,6 @@ SocketThread( return msg.wParam; } - /* *---------------------------------------------------------------------- -- cgit v0.12 From 3e08a8fd95f784a60603a05dadb5188eb388e112 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 8 May 2024 15:06:09 +0000 Subject: Add some typecasts, remove duplicate "memset", remove some spacing. --- generic/tclClockFmt.c | 2 +- win/tclWinConsole.c | 5 ++--- win/tclWinSock.c | 10 +++++----- win/tclWinTest.c | 6 +++--- 4 files changed, 11 insertions(+), 12 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 392574c..11956cc 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -2303,7 +2303,7 @@ ClockGetOrParseScanFormat( wordTok->tokWord.start = p; wordTok->map = &ScnWordTokenMap; } - + do { if (isspace(UCHAR(*p))) { fss->scnSpaceCount++; diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index c7e12ae..d34104e 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -341,7 +341,7 @@ RingBufferInit( if (capacity <= 0 || capacity > TCL_SIZE_MAX) { Tcl_Panic("Internal error: invalid ring buffer capacity requested."); } - ringPtr->bufPtr = (char *) ckalloc(capacity); + ringPtr->bufPtr = (char *)ckalloc(capacity); ringPtr->capacity = capacity; ringPtr->start = 0; ringPtr->length = 0; @@ -2006,8 +2006,7 @@ AllocateConsoleHandleInfo( ConsoleHandleInfo *handleInfoPtr; DWORD consoleMode; - handleInfoPtr = (ConsoleHandleInfo *) ckalloc(sizeof(*handleInfoPtr)); - memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); + handleInfoPtr = (ConsoleHandleInfo *)ckalloc(sizeof(*handleInfoPtr)); memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); handleInfoPtr->console = consoleHandle; InitializeSRWLock(&handleInfoPtr->lock); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index e427c39..d7c137a 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -403,7 +403,7 @@ InitializeHostName( *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); *lengthPtr = Tcl_DStringLength(&ds); - *valuePtr = (char *) ckalloc(*lengthPtr + 1); + *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); Tcl_DStringFree(&ds); } @@ -2572,7 +2572,7 @@ SocketCheckProc( statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { SET_BITS(statePtr->flags, SOCKET_PENDING); - evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent)); + evPtr = (SocketEvent *)ckalloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; evPtr->socket = statePtr->sockets->fd; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -2847,7 +2847,7 @@ AddSocketInfoFd( * Add the first FD. */ - statePtr->sockets = (TcpFdList *) ckalloc(sizeof(TcpFdList)); + statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList)); fds = statePtr->sockets; } else { /* @@ -2858,7 +2858,7 @@ AddSocketInfoFd( fds = fds->next; } - fds->next = (TcpFdList *) ckalloc(sizeof(TcpFdList)); + fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList)); fds = fds->next; } @@ -2891,7 +2891,7 @@ static TcpState * NewSocketInfo( SOCKET socket) { - TcpState *statePtr = (TcpState *) ckalloc(sizeof(TcpState)); + TcpState *statePtr = (TcpState *)ckalloc(sizeof(TcpState)); memset(statePtr, 0, sizeof(TcpState)); diff --git a/win/tclWinTest.c b/win/tclWinTest.c index ec12f67..44ff038 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -485,7 +485,7 @@ TestplatformChmod( goto done; } aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid); - aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen); + aceEntry[nSids].pSid = (PSID)ckalloc(aceEntry[nSids].sidLen); if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenUser->User.Sid)) { ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ @@ -527,7 +527,7 @@ TestplatformChmod( goto done; } aceEntry[nSids].sidLen = GetLengthSid(pTokenGroup->PrimaryGroup); - aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen); + aceEntry[nSids].pSid = (PSID)ckalloc(aceEntry[nSids].sidLen); if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenGroup->PrimaryGroup)) { ckfree(pTokenGroup); ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ @@ -557,7 +557,7 @@ TestplatformChmod( goto done; } aceEntry[nSids].sidLen = GetLengthSid(pWorldSid); - aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen); + aceEntry[nSids].pSid = (PSID)ckalloc(aceEntry[nSids].sidLen); if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pWorldSid)) { LocalFree(pWorldSid); ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ -- cgit v0.12 From cf8139d2afbd119b766831b951b2bf59feec8b5a Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 9 May 2024 15:38:18 +0000 Subject: Tidy up the zlib code a bit In particular, 'cd' was used for vars of different types (ClientData, ZlibChannelData) which was quite confusing. --- generic/tclZlib.c | 816 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 430 insertions(+), 386 deletions(-) diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 4138089..595ddf4 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -33,11 +33,12 @@ * format or automatic detection of format. Putting it here is slightly less * gross! */ - -#define WBITS_RAW (-MAX_WBITS) -#define WBITS_ZLIB (MAX_WBITS) -#define WBITS_GZIP (MAX_WBITS | 16) -#define WBITS_AUTODETECT (MAX_WBITS | 32) +enum WBitsFlags { + WBITS_RAW = (-MAX_WBITS), /* RAW compressed data */ + WBITS_ZLIB = (MAX_WBITS), /* Zlib-format compressed data */ + WBITS_GZIP = (MAX_WBITS | 16), /* Gzip-format compressed data */ + WBITS_AUTODETECT = (MAX_WBITS | 32) /* Auto-detect format from its header */ +}; /* * Structure used for handling gzip headers that are generated from a @@ -64,7 +65,7 @@ typedef struct { Tcl_Obj *inData, *outData; /* Input / output buffers (lists) */ Tcl_Obj *currentInput; /* Pointer to what is currently being * inflated. */ - Tcl_Size outPos; + Tcl_Size outPos; /* Index into output buffer to write to next. */ int mode; /* Either TCL_ZLIB_STREAM_DEFLATE or * TCL_ZLIB_STREAM_INFLATE. */ int format; /* Flags from the TCL_ZLIB_FORMAT_* */ @@ -82,9 +83,11 @@ typedef struct { * structure. */ } ZlibStreamHandle; -#define DICT_TO_SET 0x1 /* If we need to set a compression dictionary +enum ZlibStreamHandleFlags { + DICT_TO_SET = 0x1 /* If we need to set a compression dictionary * in the low-level engine at the next * opportunity. */ +}; /* * Macros to make it clearer in some of the twiddlier accesses what is @@ -130,21 +133,18 @@ typedef struct { } ZlibChannelData; /* - * Value bits for the flags field. Definitions are: - * ASYNC - Whether this is an asynchronous channel. - * IN_HEADER - Whether the inHeader field has been registered with - * the input compressor. - * OUT_HEADER - Whether the outputHeader field has been registered - * with the output decompressor. - * STREAM_DECOMPRESS - Signal decompress pending data. - * STREAM_DONE - Flag to signal stream end up to transform input. + * Value bits for the ZlibChannelData::flags field. */ - -#define ASYNC 0x01 -#define IN_HEADER 0x02 -#define OUT_HEADER 0x04 -#define STREAM_DECOMPRESS 0x08 -#define STREAM_DONE 0x10 +enum ZlibChannelDataFlags { + ASYNC = 0x01, /* Set if this is an asynchronous channel. */ + IN_HEADER = 0x02, /* Set if the inHeader field has been + * registered with the input compressor. */ + OUT_HEADER = 0x04, /* Set if the outputHeader field has been + * registered with the output decompressor. */ + STREAM_DECOMPRESS = 0x08, /* Set to signal decompress pending data. */ + STREAM_DONE = 0x10 /* Set to signal stream end up to transform + * input. */ +}; /* * Size of buffers allocated by default, and the range it can be set to. The @@ -187,8 +187,9 @@ static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj, GzipHeader *headerPtr, int *extraSizePtr); static int ZlibPushSubcmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ResultDecompress(ZlibChannelData *cd, char *buf, - int toRead, int flush, int *errorCodePtr); +static int ResultDecompress(ZlibChannelData *chanDataPtr, + char *buf, int toRead, int flush, + int *errorCodePtr); static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp, int mode, int format, int level, int limit, Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr, @@ -196,7 +197,8 @@ static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp, static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr); static int ZlibStreamSubcmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static inline void ZlibTransformEventTimerKill(ZlibChannelData *cd); +static inline void ZlibTransformEventTimerKill( + ZlibChannelData *chanDataPtr); static void ZlibTransformTimerRun(void *clientData); /* @@ -214,7 +216,7 @@ static const Tcl_ChannelType zlibChannelType = { ZlibTransformGetOption, ZlibTransformWatch, ZlibTransformGetHandle, - ZlibTransformClose, /* close2Proc */ + ZlibTransformClose, /* close2Proc */ ZlibTransformBlockMode, NULL, /* flushProc */ ZlibTransformEventHandler, @@ -262,7 +264,8 @@ ConvertError( */ case Z_ERRNO: - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp),-1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_PosixError(interp), TCL_AUTO_LENGTH)); return; /* @@ -313,7 +316,7 @@ ConvertError( snprintf(codeStrBuf, sizeof(codeStrBuf), "%d", code); break; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), TCL_AUTO_LENGTH)); /* * Tricky point! We might pass NULL twice here (and will when the error @@ -350,11 +353,11 @@ ConvertErrorToList( return Tcl_NewListObj(3, objv); case Z_ERRNO: TclNewLiteralStringObj(objv[2], "POSIX"); - objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); + objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), TCL_AUTO_LENGTH); return Tcl_NewListObj(4, objv); case Z_NEED_DICT: TclNewLiteralStringObj(objv[2], "NEED_DICT"); - TclNewIntObj(objv[3], (Tcl_WideInt)adler); + TclNewIntObj(objv[3], (Tcl_WideInt) adler); return Tcl_NewListObj(4, objv); /* @@ -405,13 +408,26 @@ GetValue( const char *nameStr, Tcl_Obj **valuePtrPtr) { - Tcl_Obj *name = Tcl_NewStringObj(nameStr, -1); + Tcl_Obj *name = Tcl_NewStringObj(nameStr, TCL_AUTO_LENGTH); int result = Tcl_DictObjGet(interp, dictObj, name, valuePtrPtr); TclDecrRefCount(name); return result; } +/* + * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). + */ +static inline Tcl_Encoding +Latin1(void) +{ + Tcl_Encoding latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); + if (latin1enc == NULL) { + Tcl_Panic("no latin-1 encoding"); + } + return latin1enc; +} + static int GenerateHeader( Tcl_Interp *interp, /* Where to put error messages. */ @@ -426,39 +442,31 @@ GenerateHeader( Tcl_Size length; Tcl_WideInt wideValue = 0; const char *valueStr; - Tcl_Encoding latin1enc; + Tcl_Encoding latin1enc = Latin1(); static const char *const types[] = { "binary", "text" }; - /* - * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). - */ - - latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); - if (latin1enc == NULL) { - Tcl_Panic("no latin-1 encoding"); - } - if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { goto error; } else if (value != NULL) { Tcl_EncodingState state; valueStr = TclGetStringFromObj(value, &length); result = Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, - TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT, &state, - headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len, - NULL); + TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT, + &state, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN - 1, NULL, + &len, NULL); if (result != TCL_OK) { if (interp) { if (result == TCL_CONVERT_UNKNOWN) { - Tcl_AppendResult( - interp, "Comment contains characters > 0xFF", (char *)NULL); + Tcl_AppendResult(interp, + "Comment contains characters > 0xFF", (char *)NULL); } else { - Tcl_AppendResult(interp, "Comment too large for zip", (char *)NULL); + Tcl_AppendResult(interp, "Comment too large for zip", + (char *)NULL); } } - result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR*/ + result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR */ goto error; } headerPtr->nativeCommentBuf[len] = '\0'; @@ -481,20 +489,20 @@ GenerateHeader( Tcl_EncodingState state; valueStr = TclGetStringFromObj(value, &length); result = Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, - TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT, &state, - headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, - NULL); + TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT, + &state, headerPtr->nativeFilenameBuf, MAXPATHLEN - 1, NULL, + &len, NULL); if (result != TCL_OK) { if (interp) { if (result == TCL_CONVERT_UNKNOWN) { - Tcl_AppendResult( - interp, "Filename contains characters > 0xFF", (char *)NULL); + Tcl_AppendResult(interp, + "Filename contains characters > 0xFF", (char *)NULL); } else { - Tcl_AppendResult( - interp, "Filename too large for zip", (char *)NULL); + Tcl_AppendResult(interp, + "Filename too large for zip", (char *)NULL); } } - result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR*/ + result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR */ goto error; } headerPtr->nativeFilenameBuf[len] = '\0'; @@ -555,7 +563,8 @@ GenerateHeader( */ #define SetValue(dictObj, key, value) \ - Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value)) + Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj( \ + (key), TCL_AUTO_LENGTH), (value)) static void ExtractHeader( @@ -567,35 +576,21 @@ ExtractHeader( if (headerPtr->comment != Z_NULL) { if (latin1enc == NULL) { - /* - * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). - */ - - latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); - if (latin1enc == NULL) { - Tcl_Panic("no latin-1 encoding"); - } + latin1enc = Latin1(); } - (void)Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, TCL_INDEX_NONE, - &tmp); + (void) Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, + TCL_AUTO_LENGTH, &tmp); SetValue(dictObj, "comment", Tcl_DStringToObj(&tmp)); } SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc)); if (headerPtr->name != Z_NULL) { if (latin1enc == NULL) { - /* - * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). - */ - - latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); - if (latin1enc == NULL) { - Tcl_Panic("no latin-1 encoding"); - } + latin1enc = Latin1(); } - (void)Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, TCL_INDEX_NONE, - &tmp); + (void) Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, + TCL_AUTO_LENGTH, &tmp); SetValue(dictObj, "filename", Tcl_DStringToObj(&tmp)); } if (headerPtr->os != 255) { @@ -605,8 +600,8 @@ ExtractHeader( SetValue(dictObj, "time", Tcl_NewWideIntObj(headerPtr->time)); } if (headerPtr->text != Z_UNKNOWN) { - SetValue(dictObj, "type", - Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1)); + SetValue(dictObj, "type", Tcl_NewStringObj( + headerPtr->text ? "text" : "binary", TCL_AUTO_LENGTH)); } if (latin1enc != NULL) { @@ -660,11 +655,9 @@ Deflate( int flush, size_t *writtenPtr) { - int e; - strm->next_out = (Bytef *) bufferPtr; strm->avail_out = bufferSize; - e = deflate(strm, flush); + int e = deflate(strm, flush); if (writtenPtr != NULL) { *writtenPtr = bufferSize - strm->avail_out; } @@ -737,7 +730,7 @@ Tcl_ZlibStreamInit( case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; if (dictObj) { - gzHeaderPtr = (GzipHeader *)Tcl_Alloc(sizeof(GzipHeader)); + gzHeaderPtr = (GzipHeader *) Tcl_Alloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); if (GenerateHeader(interp, dictObj, gzHeaderPtr, NULL) != TCL_OK) { @@ -771,7 +764,7 @@ Tcl_ZlibStreamInit( break; case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; - gzHeaderPtr = (GzipHeader *)Tcl_Alloc(sizeof(GzipHeader)); + gzHeaderPtr = (GzipHeader *) Tcl_Alloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); gzHeaderPtr->header.name = (Bytef *) gzHeaderPtr->nativeFilenameBuf; @@ -797,7 +790,7 @@ Tcl_ZlibStreamInit( " TCL_ZLIB_STREAM_INFLATE"); } - zshPtr = (ZlibStreamHandle *)Tcl_Alloc(sizeof(ZlibStreamHandle)); + zshPtr = (ZlibStreamHandle *) Tcl_Alloc(sizeof(ZlibStreamHandle)); zshPtr->interp = interp; zshPtr->mode = mode; zshPtr->format = format; @@ -840,7 +833,8 @@ Tcl_ZlibStreamInit( */ if (interp != NULL) { - if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", TCL_INDEX_NONE, 0) != TCL_OK) { + if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", + TCL_AUTO_LENGTH, 0) != TCL_OK) { goto error; } Tcl_DStringInit(&cmdname); @@ -849,7 +843,7 @@ Tcl_ZlibStreamInit( if (Tcl_FindCommand(interp, Tcl_DStringValue(&cmdname), NULL, 0) != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "BUG: Stream command name already exists", -1)); + "BUG: Stream command name already exists", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", (char *)NULL); Tcl_DStringFree(&cmdname); goto error; @@ -922,9 +916,9 @@ Tcl_ZlibStreamInit( static void ZlibStreamCmdDelete( - void *cd) + void *clientData) { - ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd; + ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) clientData; zshPtr->cmd = NULL; ZlibStreamCleanup(zshPtr); @@ -1241,7 +1235,7 @@ Tcl_ZlibStreamPut( if (zshPtr->streamEnd) { if (zshPtr->interp) { Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( - "already past compressed stream end", -1)); + "already past compressed stream end", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", (char *)NULL); } return TCL_ERROR; @@ -1284,7 +1278,7 @@ Tcl_ZlibStreamPut( if (outSize > BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; } - dataTmp = (char *)Tcl_Alloc(outSize); + dataTmp = (char *) Tcl_Alloc(outSize); while (1) { e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore); @@ -1318,7 +1312,7 @@ Tcl_ZlibStreamPut( if (outSize < BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; /* There may be *lots* of data left to output... */ - dataTmp = (char *)Tcl_Realloc(dataTmp, outSize); + dataTmp = (char *) Tcl_Realloc(dataTmp, outSize); } } @@ -1360,7 +1354,7 @@ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ Tcl_Obj *data, /* A place to append the data. */ - Tcl_Size count) /* Number of bytes to grab as a maximum, you + Tcl_Size count) /* Number of bytes to grab as a maximum, you * may get less! */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; @@ -1396,7 +1390,7 @@ Tcl_ZlibStreamGet( * Prepare the place to store the data. */ - dataPtr = Tcl_SetByteArrayLength(data, existing+count); + dataPtr = Tcl_SetByteArrayLength(data, existing + count); dataPtr += existing; zshPtr->stream.next_out = dataPtr; @@ -1472,7 +1466,7 @@ Tcl_ZlibStreamGet( if (zshPtr->interp) { Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( "unexpected zlib internal state during" - " decompression", -1)); + " decompression", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "STATE", (char *)NULL); } @@ -1517,7 +1511,7 @@ Tcl_ZlibStreamGet( if (e != Z_NEED_DICT || !HaveDictToSet(zshPtr)) { break; } - e = SetInflateDictionary(&zshPtr->stream,zshPtr->compDictObj); + e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj); DictWasSet(zshPtr); } while (e == Z_OK); } @@ -1570,7 +1564,7 @@ Tcl_ZlibStreamGet( Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj); itemPtr = Tcl_GetBytesFromObj(NULL, itemObj, &itemLen); - if ((itemLen-zshPtr->outPos) >= count-dataPos) { + if ((itemLen - zshPtr->outPos) >= (count - dataPos)) { Tcl_Size len = count - dataPos; memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); @@ -1817,10 +1811,10 @@ Tcl_ZlibInflate( if (gzipHeaderDictObj) { headerPtr = &header; memset(headerPtr, 0, sizeof(gz_header)); - nameBuf = (char *)Tcl_Alloc(MAXPATHLEN); + nameBuf = (char *) Tcl_Alloc(MAXPATHLEN); header.name = (Bytef *) nameBuf; header.name_max = MAXPATHLEN - 1; - commentBuf = (char *)Tcl_Alloc(MAX_COMMENT_LEN); + commentBuf = (char *) Tcl_Alloc(MAX_COMMENT_LEN); header.comment = (Bytef *) commentBuf; header.comm_max = MAX_COMMENT_LEN - 1; } @@ -1830,10 +1824,10 @@ Tcl_ZlibInflate( * Start with a buffer (up to) 3 times the size of the input data. */ - if (inLen < 32*1024*1024) { - bufferSize = 3*inLen; - } else if (inLen < 256*1024*1024) { - bufferSize = 2*inLen; + if (inLen < 32 * 1024 * 1024) { + bufferSize = 3 * inLen; + } else if (inLen < 256 * 1024 * 1024) { + bufferSize = 2 * inLen; } else { bufferSize = inLen; } @@ -1843,7 +1837,7 @@ Tcl_ZlibInflate( outData = Tcl_SetByteArrayLength(obj, bufferSize); memset(&stream, 0, sizeof(z_stream)); stream.avail_in = inLen+1; /* +1 because zlib can "over-request" - * input (but ignore it!) */ + * input (but ignore it!) */ stream.next_in = inData; stream.avail_out = bufferSize; stream.next_out = outData; @@ -1887,7 +1881,7 @@ Tcl_ZlibInflate( } newBufferSize = bufferSize + 5 * stream.avail_in; if (newBufferSize == bufferSize) { - newBufferSize = bufferSize+1000; + newBufferSize = bufferSize + 1000; } newOutData = Tcl_SetByteArrayLength(obj, newBufferSize); @@ -1979,6 +1973,8 @@ Tcl_ZlibAdler32( * * Implementation of the [zlib] command. * + * TODO: Convert this to an ensemble. + * *---------------------------------------------------------------------- */ @@ -2017,8 +2013,8 @@ ZlibCmd( } switch (command) { - case CMD_ADLER: /* adler32 str ?startvalue? - * -> checksum */ + case CMD_ADLER: /* adler32 str ?startvalue? + * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; @@ -2027,7 +2023,7 @@ ZlibCmd( if (data == NULL) { return TCL_ERROR; } - if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], + if (objc > 3 && Tcl_GetIntFromObj(interp, objv[3], (int *) &start) != TCL_OK) { return TCL_ERROR; } @@ -2037,8 +2033,8 @@ ZlibCmd( Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibAdler32(start, data, dlen))); return TCL_OK; - case CMD_CRC: /* crc32 str ?startvalue? - * -> checksum */ + case CMD_CRC: /* crc32 str ?startvalue? + * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; @@ -2047,7 +2043,7 @@ ZlibCmd( if (data == NULL) { return TCL_ERROR; } - if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], + if (objc > 3 && Tcl_GetIntFromObj(interp, objv[3], (int *) &start) != TCL_OK) { return TCL_ERROR; } @@ -2057,8 +2053,8 @@ ZlibCmd( Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibCRC32(start, data, dlen))); return TCL_OK; - case CMD_DEFLATE: /* deflate data ?level? - * -> rawCompressedData */ + case CMD_DEFLATE: /* deflate data ?level? + * -> rawCompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?level?"); return TCL_ERROR; @@ -2073,8 +2069,8 @@ ZlibCmd( } return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], level, NULL); - case CMD_COMPRESS: /* compress data ?level? - * -> zlibCompressedData */ + case CMD_COMPRESS: /* compress data ?level? + * -> zlibCompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?level?"); return TCL_ERROR; @@ -2089,8 +2085,8 @@ ZlibCmd( } return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], level, NULL); - case CMD_GZIP: /* gzip data ?level? - * -> gzippedCompressedData */ + case CMD_GZIP: /* gzip data ?level? + * -> gzippedCompressedData */ headerDictObj = NULL; /* @@ -2123,10 +2119,10 @@ ZlibCmd( } switch (option) { case 0: - headerDictObj = objv[i+1]; + headerDictObj = objv[i + 1]; break; case 1: - if (Tcl_GetIntFromObj(interp, objv[i+1], + if (Tcl_GetIntFromObj(interp, objv[i + 1], &level) != TCL_OK) { return TCL_ERROR; } @@ -2139,8 +2135,8 @@ ZlibCmd( } return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], level, headerDictObj); - case CMD_INFLATE: /* inflate rawcomprdata ?bufferSize? - * -> decompressedData */ + case CMD_INFLATE: /* inflate rawcomprdata ?bufferSize? + * -> decompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?"); return TCL_ERROR; @@ -2158,9 +2154,8 @@ ZlibCmd( } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], buffersize, NULL); - case CMD_DECOMPRESS: /* decompress zlibcomprdata \ - * ?bufferSize? - * -> decompressedData */ + case CMD_DECOMPRESS: /* decompress zlibcomprdata ?bufferSize? + * -> decompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?"); return TCL_ERROR; @@ -2178,8 +2173,8 @@ ZlibCmd( } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], buffersize, NULL); - case CMD_GUNZIP: { /* gunzip gzippeddata ?bufferSize? - * -> decompressedData */ + case CMD_GUNZIP: { /* gunzip gzippeddata ?-headerVar varName? + * -> decompressedData */ Tcl_Obj *headerVarObj; if (objc < 3 || objc > 5 || ((objc & 1) == 0)) { @@ -2198,7 +2193,7 @@ ZlibCmd( } switch (option) { case 0: - if (TclGetWideIntFromObj(interp, objv[i+1], + if (TclGetWideIntFromObj(interp, objv[i + 1], &wideLen) != TCL_OK) { return TCL_ERROR; } @@ -2209,7 +2204,7 @@ ZlibCmd( buffersize = wideLen; break; case 1: - headerVarObj = objv[i+1]; + headerVarObj = objv[i + 1]; TclNewObj(headerDictObj); break; } @@ -2227,19 +2222,19 @@ ZlibCmd( } return TCL_OK; } - case CMD_STREAM: /* stream deflate/inflate/...gunzip \ - * ?options...? - * -> handleCmd */ + case CMD_STREAM: /* stream deflate/inflate/...gunzip options... + * -> handleCmd */ return ZlibStreamSubcmd(interp, objc, objv); - case CMD_PUSH: /* push mode channel options... - * -> channel */ + case CMD_PUSH: /* push mode channel options... + * -> channel */ return ZlibPushSubcmd(interp, objc, objv); - }; + } return TCL_ERROR; badLevel: - Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "level must be 0 to 9", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", (char *)NULL); if (extraInfoStr) { Tcl_AddErrorInfo(interp, extraInfoStr); @@ -2370,7 +2365,7 @@ ZlibStreamSubcmd( sizeof(OptDescriptor), "option", 0, &option) != TCL_OK) { return TCL_ERROR; } - obj[desc[option].offset] = objv[i+1]; + obj[desc[option].offset] = objv[i + 1]; } /* @@ -2383,7 +2378,8 @@ ZlibStreamSubcmd( } else if (Tcl_GetIntFromObj(interp, levelObj, &level) != TCL_OK) { return TCL_ERROR; } else if (level < 0 || level > 9) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "level must be 0 to 9", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", (char *)NULL); Tcl_AddErrorInfo(interp, "\n (in -level option)"); return TCL_ERROR; @@ -2492,7 +2488,7 @@ ZlibPushSubcmd( Tcl_Panic("should be unreachable"); } - if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode, 0) != TCL_OK){ + if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode, 0) != TCL_OK) { return TCL_ERROR; } @@ -2502,13 +2498,15 @@ ZlibPushSubcmd( if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "compression may only be applied to writable channels", -1)); + "compression may only be applied to writable channels", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", (char *)NULL); return TCL_ERROR; } if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "decompression may only be applied to readable channels",TCL_INDEX_NONE)); + "decompression may only be applied to readable channels", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", (char *)NULL); return TCL_ERROR; } @@ -2523,33 +2521,33 @@ ZlibPushSubcmd( &option) != TCL_OK) { return TCL_ERROR; } - if (++i > objc-1) { + if (++i > objc - 1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "value missing for %s option", pushOptions[option])); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } switch (option) { - case poHeader: + case poHeader: /* -header headerDict */ headerObj = objv[i]; if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) { goto genericOptionError; } break; - case poLevel: - if (Tcl_GetIntFromObj(interp, objv[i], (int*) &level) != TCL_OK) { + case poLevel: /* -level compLevel */ + if (Tcl_GetIntFromObj(interp, objv[i], (int *) &level) != TCL_OK) { goto genericOptionError; } if (level < 0 || level > 9) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "level must be 0 to 9", -1)); + "level must be 0 to 9", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", (char *)NULL); goto genericOptionError; } break; - case poLimit: - if (Tcl_GetIntFromObj(interp, objv[i], (int*) &limit) != TCL_OK) { + case poLimit: /* -limit numBytes */ + if (Tcl_GetIntFromObj(interp, objv[i], (int *) &limit) != TCL_OK) { goto genericOptionError; } if (limit < 1 || limit > MAX_BUFFER_SIZE) { @@ -2560,11 +2558,11 @@ ZlibPushSubcmd( goto genericOptionError; } break; - case poDictionary: + case poDictionary: /* -dictionary compDict */ if (format == TCL_ZLIB_FORMAT_GZIP) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "a compression dictionary may not be set in the " - "gzip format", -1)); + "gzip format", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOPT", (char *)NULL); goto genericOptionError; } @@ -2573,7 +2571,8 @@ ZlibPushSubcmd( } } - if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (Tcl_Size *)NULL))) { + if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, + (Tcl_Size *)NULL))) { return TCL_ERROR; } @@ -2603,12 +2602,12 @@ ZlibPushSubcmd( static int ZlibStreamCmd( - void *cd, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; + Tcl_ZlibStream zstream = (Tcl_ZlibStream) clientData; int count, code; Tcl_Obj *obj; static const char *const cmds[] = { @@ -2729,12 +2728,12 @@ ZlibStreamCmd( static int ZlibStreamAddCmd( - void *cd, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; + Tcl_ZlibStream zstream = (Tcl_ZlibStream) clientData; int code, buffersize = -1, flush = -1, i; Tcl_Obj *obj, *compDictObj = NULL; static const char *const add_options[] = { @@ -2751,32 +2750,32 @@ ZlibStreamAddCmd( } switch (index) { - case ao_flush: /* -flush */ + case ao_flush: /* -flush */ if (flush >= 0) { flush = -2; } else { flush = Z_SYNC_FLUSH; } break; - case ao_fullflush: /* -fullflush */ + case ao_fullflush: /* -fullflush */ if (flush >= 0) { flush = -2; } else { flush = Z_FULL_FLUSH; } break; - case ao_finalize: /* -finalize */ + case ao_finalize: /* -finalize */ if (flush >= 0) { flush = -2; } else { flush = Z_FINISH; } break; - case ao_buffer: /* -buffer */ - if (i == objc-2) { + case ao_buffer: /* -buffer bufferSize */ + if (i == objc - 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-buffer\" option must be followed by integer " - "decompression buffersize", -1)); + "decompression buffersize", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } @@ -2791,11 +2790,11 @@ ZlibStreamAddCmd( return TCL_ERROR; } break; - case ao_dictionary: - if (i == objc-2) { + case ao_dictionary: /* -dictionary compDict */ + if (i == objc - 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-dictionary\" option must be followed by" - " compression dictionary bytes", -1)); + " compression dictionary bytes", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } @@ -2806,7 +2805,7 @@ ZlibStreamAddCmd( if (flush == -2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-flush\", \"-fullflush\" and \"-finalize\" options" - " are mutually exclusive", -1)); + " are mutually exclusive", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", (char *)NULL); return TCL_ERROR; } @@ -2836,7 +2835,7 @@ ZlibStreamAddCmd( * Send the data to the stream core, along with any flushing directive. */ - if (Tcl_ZlibStreamPut(zstream, objv[objc-1], flush) != TCL_OK) { + if (Tcl_ZlibStreamPut(zstream, objv[objc - 1], flush) != TCL_OK) { return TCL_ERROR; } @@ -2856,12 +2855,12 @@ ZlibStreamAddCmd( static int ZlibStreamPutCmd( - void *cd, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; + Tcl_ZlibStream zstream = (Tcl_ZlibStream) clientData; int flush = -1, i; Tcl_Obj *compDictObj = NULL; static const char *const put_options[] = { @@ -2878,32 +2877,32 @@ ZlibStreamPutCmd( } switch (index) { - case po_flush: /* -flush */ + case po_flush: /* -flush */ if (flush >= 0) { flush = -2; } else { flush = Z_SYNC_FLUSH; } break; - case po_fullflush: /* -fullflush */ + case po_fullflush: /* -fullflush */ if (flush >= 0) { flush = -2; } else { flush = Z_FULL_FLUSH; } break; - case po_finalize: /* -finalize */ + case po_finalize: /* -finalize */ if (flush >= 0) { flush = -2; } else { flush = Z_FINISH; } break; - case po_dictionary: - if (i == objc-2) { + case po_dictionary: /* -dictionary compDict */ + if (i == objc - 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-dictionary\" option must be followed by" - " compression dictionary bytes", -1)); + " compression dictionary bytes", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } @@ -2913,7 +2912,7 @@ ZlibStreamPutCmd( if (flush == -2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-flush\", \"-fullflush\" and \"-finalize\" options" - " are mutually exclusive", -1)); + " are mutually exclusive", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", (char *)NULL); return TCL_ERROR; } @@ -2942,17 +2941,17 @@ ZlibStreamPutCmd( * Send the data to the stream core, along with any flushing directive. */ - return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush); + return Tcl_ZlibStreamPut(zstream, objv[objc - 1], flush); } static int ZlibStreamHeaderCmd( - void *cd, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd; + ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) clientData; Tcl_Obj *resultObj; if (objc != 2) { @@ -2961,7 +2960,8 @@ ZlibStreamHeaderCmd( } else if (zshPtr->mode != TCL_ZLIB_STREAM_INFLATE || zshPtr->format != TCL_ZLIB_FORMAT_GZIP) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "only gunzip streams can produce header information", -1)); + "only gunzip streams can produce header information", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOP", (char *)NULL); return TCL_ERROR; } @@ -2976,6 +2976,17 @@ ZlibStreamHeaderCmd( *---------------------------------------------------------------------- * Set of functions to support channel stacking. *---------------------------------------------------------------------- + */ + +static inline int +HaveFlag( + ZlibChannelData *chanDataPtr, + int flag) +{ + return (chanDataPtr->flags & flag) != 0; +} + +/* * * ZlibTransformClose -- * @@ -2988,9 +2999,9 @@ static int ZlibTransformClose( void *instanceData, Tcl_Interp *interp, - int flags) + int flags) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; int e, result = TCL_OK; size_t written; @@ -3002,17 +3013,17 @@ ZlibTransformClose( * Delete the support timer. */ - ZlibTransformEventTimerKill(cd); + ZlibTransformEventTimerKill(chanDataPtr); /* * Flush any data waiting to be compressed. */ - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - cd->outStream.avail_in = 0; + if (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { + chanDataPtr->outStream.avail_in = 0; do { - e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated, - Z_FINISH, &written); + e = Deflate(&chanDataPtr->outStream, chanDataPtr->outBuffer, + chanDataPtr->outAllocated, Z_FINISH, &written); /* * Can't be sure that deflate() won't declare the buffer to be @@ -3021,17 +3032,18 @@ ZlibTransformClose( if (e == Z_BUF_ERROR) { e = Z_OK; - written = cd->outAllocated; + written = chanDataPtr->outAllocated; } if (e != Z_OK && e != Z_STREAM_END) { /* TODO: is this the right way to do errors on close? */ if (!TclInThreadExit()) { - ConvertError(interp, e, cd->outStream.adler); + ConvertError(interp, e, chanDataPtr->outStream.adler); } result = TCL_ERROR; break; } - if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) == TCL_IO_FAILURE) { + if (written && Tcl_WriteRaw(chanDataPtr->parent, + chanDataPtr->outBuffer, written) == TCL_IO_FAILURE) { /* TODO: is this the right way to do errors on close? * Note: when close is called from FinalizeIOSubsystem then * interp may be NULL */ @@ -3044,38 +3056,40 @@ ZlibTransformClose( break; } } while (e != Z_STREAM_END); - (void) deflateEnd(&cd->outStream); + (void) deflateEnd(&chanDataPtr->outStream); } else { /* * If we have unused bytes from the read input (overshot by * Z_STREAM_END or on possible error), unget them back to the parent * channel, so that they appear as not being read yet. */ - if (cd->inStream.avail_in) { - Tcl_Ungets (cd->parent, (char *)cd->inStream.next_in, cd->inStream.avail_in, 0); + if (chanDataPtr->inStream.avail_in) { + Tcl_Ungets(chanDataPtr->parent, + (char *) chanDataPtr->inStream.next_in, + chanDataPtr->inStream.avail_in, 0); } - (void) inflateEnd(&cd->inStream); + (void) inflateEnd(&chanDataPtr->inStream); } /* * Release all memory. */ - if (cd->compDictObj) { - Tcl_DecrRefCount(cd->compDictObj); - cd->compDictObj = NULL; + if (chanDataPtr->compDictObj) { + Tcl_DecrRefCount(chanDataPtr->compDictObj); + chanDataPtr->compDictObj = NULL; } - if (cd->inBuffer) { - Tcl_Free(cd->inBuffer); - cd->inBuffer = NULL; + if (chanDataPtr->inBuffer) { + Tcl_Free(chanDataPtr->inBuffer); + chanDataPtr->inBuffer = NULL; } - if (cd->outBuffer) { - Tcl_Free(cd->outBuffer); - cd->outBuffer = NULL; + if (chanDataPtr->outBuffer) { + Tcl_Free(chanDataPtr->outBuffer); + chanDataPtr->outBuffer = NULL; } - Tcl_Free(cd); + Tcl_Free(chanDataPtr); return result; } @@ -3096,31 +3110,32 @@ ZlibTransformInput( int toRead, int *errorCodePtr) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; Tcl_DriverInputProc *inProc = - Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent)); + Tcl_ChannelInputProc(Tcl_GetChannelType(chanDataPtr->parent)); int readBytes, gotBytes; - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead, - errorCodePtr); + if (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { + return inProc(Tcl_GetChannelInstanceData(chanDataPtr->parent), buf, + toRead, errorCodePtr); } gotBytes = 0; - readBytes = cd->inStream.avail_in; /* how many bytes in buffer now */ - while (!(cd->flags & STREAM_DONE) && toRead > 0) { - unsigned int n; int decBytes; + readBytes = chanDataPtr->inStream.avail_in; /* how many bytes in buffer now */ + while (!HaveFlag(chanDataPtr, STREAM_DONE) && toRead > 0) { + unsigned int n; + int decBytes; /* if starting from scratch or continuation after full decompression */ - if (!cd->inStream.avail_in) { + if (!chanDataPtr->inStream.avail_in) { /* buffer to start, we can read to whole available buffer */ - cd->inStream.next_in = (Bytef *) cd->inBuffer; + chanDataPtr->inStream.next_in = (Bytef *) chanDataPtr->inBuffer; } /* * If done - no read needed anymore, check we have to copy rest of * decompressed data, otherwise return with size (or 0 for Eof) */ - if (cd->flags & STREAM_DECOMPRESS) { + if (HaveFlag(chanDataPtr, STREAM_DECOMPRESS)) { goto copyDecompressed; } /* @@ -3131,7 +3146,8 @@ ZlibTransformInput( */ /* Check free buffer size and adjust size of next chunk to read. */ - n = cd->inAllocated - ((char *)cd->inStream.next_in - cd->inBuffer); + n = chanDataPtr->inAllocated - ((char *) + chanDataPtr->inStream.next_in - chanDataPtr->inBuffer); if (n <= 0) { /* Normally unreachable: not enough input buffer to uncompress. * Todo: firstly try to realloc inBuffer upto MAX_BUFFER_SIZE. @@ -3139,10 +3155,11 @@ ZlibTransformInput( *errorCodePtr = ENOBUFS; return -1; } - if (n > cd->readAheadLimit) { - n = cd->readAheadLimit; + if (n > chanDataPtr->readAheadLimit) { + n = chanDataPtr->readAheadLimit; } - readBytes = Tcl_ReadRaw(cd->parent, (char *)cd->inStream.next_in, n); + readBytes = Tcl_ReadRaw(chanDataPtr->parent, + (char *) chanDataPtr->inStream.next_in, n); /* * Three cases here: @@ -3155,9 +3172,8 @@ ZlibTransformInput( */ if (readBytes == -1) { - /* See ReflectInput() in tclIORTrans.c */ - if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) { + if (Tcl_InputBlocked(chanDataPtr->parent) && (gotBytes > 0)) { break; } @@ -3166,7 +3182,7 @@ ZlibTransformInput( } /* more bytes (or Eof if readBytes == 0) */ - cd->inStream.avail_in += readBytes; + chanDataPtr->inStream.avail_in += readBytes; copyDecompressed: @@ -3178,9 +3194,8 @@ copyDecompressed: * partial data waiting is converted and returned. */ - decBytes = ResultDecompress(cd, buf, toRead, - (readBytes != 0) ? Z_NO_FLUSH : Z_SYNC_FLUSH, - errorCodePtr); + decBytes = ResultDecompress(chanDataPtr, buf, toRead, + (readBytes != 0) ? Z_NO_FLUSH : Z_SYNC_FLUSH, errorCodePtr); if (decBytes == -1) { return -1; } @@ -3188,15 +3203,15 @@ copyDecompressed: buf += decBytes; toRead -= decBytes; - if (((decBytes == 0) || (cd->flags & STREAM_DECOMPRESS))) { + if ((decBytes == 0) || HaveFlag(chanDataPtr, STREAM_DECOMPRESS)) { /* * The drain delivered nothing (or buffer too small to decompress). * Time to deliver what we've got. */ - if (!gotBytes && !(cd->flags & STREAM_DONE)) { + if (!gotBytes && !HaveFlag(chanDataPtr, STREAM_DONE)) { /* if no-data, but not ready - avoid signaling Eof, * continue in blocking mode, otherwise EAGAIN */ - if (Tcl_InputBlocked(cd->parent)) { + if (Tcl_InputBlocked(chanDataPtr->parent)) { continue; } *errorCodePtr = EAGAIN; @@ -3231,16 +3246,16 @@ ZlibTransformOutput( int toWrite, int *errorCodePtr) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; Tcl_DriverOutputProc *outProc = - Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent)); + Tcl_ChannelOutputProc(Tcl_GetChannelType(chanDataPtr->parent)); int e; size_t produced; Tcl_Obj *errObj; - if (cd->mode == TCL_ZLIB_STREAM_INFLATE) { - return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite, - errorCodePtr); + if (chanDataPtr->mode == TCL_ZLIB_STREAM_INFLATE) { + return outProc(Tcl_GetChannelInstanceData(chanDataPtr->parent), buf, + toWrite, errorCodePtr); } /* @@ -3251,32 +3266,34 @@ ZlibTransformOutput( return 0; } - cd->outStream.next_in = (Bytef *) buf; - cd->outStream.avail_in = toWrite; - while (cd->outStream.avail_in > 0) { - e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated, - Z_NO_FLUSH, &produced); + chanDataPtr->outStream.next_in = (Bytef *) buf; + chanDataPtr->outStream.avail_in = toWrite; + while (chanDataPtr->outStream.avail_in > 0) { + e = Deflate(&chanDataPtr->outStream, chanDataPtr->outBuffer, + chanDataPtr->outAllocated, Z_NO_FLUSH, &produced); if (e != Z_OK || produced == 0) { break; } - if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) == TCL_IO_FAILURE) { + if (Tcl_WriteRaw(chanDataPtr->parent, chanDataPtr->outBuffer, + produced) == TCL_IO_FAILURE) { *errorCodePtr = Tcl_GetErrno(); return -1; } } if (e == Z_OK) { - return toWrite - cd->outStream.avail_in; + return toWrite - chanDataPtr->outStream.avail_in; } errObj = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1)); + Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj( + "-errorcode", TCL_AUTO_LENGTH)); Tcl_ListObjAppendElement(NULL, errObj, - ConvertErrorToList(e, cd->outStream.adler)); + ConvertErrorToList(e, chanDataPtr->outStream.adler)); Tcl_ListObjAppendElement(NULL, errObj, - Tcl_NewStringObj(cd->outStream.msg, -1)); - Tcl_SetChannelError(cd->parent, errObj); + Tcl_NewStringObj(chanDataPtr->outStream.msg, TCL_AUTO_LENGTH)); + Tcl_SetChannelError(chanDataPtr->parent, errObj); *errorCodePtr = EINVAL; return -1; } @@ -3294,22 +3311,22 @@ ZlibTransformOutput( static int ZlibTransformFlush( Tcl_Interp *interp, - ZlibChannelData *cd, + ZlibChannelData *chanDataPtr, int flushType) { int e; size_t len; - cd->outStream.avail_in = 0; + chanDataPtr->outStream.avail_in = 0; do { /* * Get the bytes to go out of the compression engine. */ - e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated, - flushType, &len); + e = Deflate(&chanDataPtr->outStream, chanDataPtr->outBuffer, + chanDataPtr->outAllocated, flushType, &len); if (e != Z_OK && e != Z_BUF_ERROR) { - ConvertError(interp, e, cd->outStream.adler); + ConvertError(interp, e, chanDataPtr->outStream.adler); return TCL_ERROR; } @@ -3317,7 +3334,8 @@ ZlibTransformFlush( * Write the bytes we've received to the next layer. */ - if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) == TCL_IO_FAILURE) { + if (len > 0 && Tcl_WriteRaw(chanDataPtr->parent, chanDataPtr->outBuffer, + len) == TCL_IO_FAILURE) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "problem flushing channel: %s", Tcl_PosixError(interp))); @@ -3354,17 +3372,17 @@ ZlibTransformSetOption( /* not used */ const char *optionName, const char *value) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; Tcl_DriverSetOptionProc *setOptionProc = - Tcl_ChannelSetOptionProc(Tcl_GetChannelType(cd->parent)); + Tcl_ChannelSetOptionProc(Tcl_GetChannelType(chanDataPtr->parent)); static const char *compressChanOptions = "dictionary flush"; static const char *gzipChanOptions = "flush"; static const char *decompressChanOptions = "dictionary limit"; static const char *gunzipChanOptions = "flush limit"; - int haveFlushOpt = (cd->mode == TCL_ZLIB_STREAM_DEFLATE); + int haveFlushOpt = (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE); if (optionName && (strcmp(optionName, "-dictionary") == 0) - && (cd->format != TCL_ZLIB_FORMAT_GZIP)) { + && (chanDataPtr->format != TCL_ZLIB_FORMAT_GZIP)) { Tcl_Obj *compDictObj; int code; @@ -3374,21 +3392,21 @@ ZlibTransformSetOption( /* not used */ Tcl_DecrRefCount(compDictObj); return TCL_ERROR; } - if (cd->compDictObj) { - TclDecrRefCount(cd->compDictObj); + if (chanDataPtr->compDictObj) { + TclDecrRefCount(chanDataPtr->compDictObj); } - cd->compDictObj = compDictObj; + chanDataPtr->compDictObj = compDictObj; code = Z_OK; - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - code = SetDeflateDictionary(&cd->outStream, compDictObj); + if (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { + code = SetDeflateDictionary(&chanDataPtr->outStream, compDictObj); if (code != Z_OK) { - ConvertError(interp, code, cd->outStream.adler); + ConvertError(interp, code, chanDataPtr->outStream.adler); return TCL_ERROR; } - } else if (cd->format == TCL_ZLIB_FORMAT_RAW) { - code = SetInflateDictionary(&cd->inStream, compDictObj); + } else if (chanDataPtr->format == TCL_ZLIB_FORMAT_RAW) { + code = SetInflateDictionary(&chanDataPtr->inStream, compDictObj); if (code != Z_OK) { - ConvertError(interp, code, cd->inStream.adler); + ConvertError(interp, code, chanDataPtr->inStream.adler); return TCL_ERROR; } } @@ -3415,7 +3433,7 @@ ZlibTransformSetOption( /* not used */ * Try to actually do the flush now. */ - return ZlibTransformFlush(interp, cd, flushType); + return ZlibTransformFlush(interp, chanDataPtr, flushType); } } else { if (optionName && strcmp(optionName, "-limit") == 0) { @@ -3425,21 +3443,22 @@ ZlibTransformSetOption( /* not used */ return TCL_ERROR; } else if (newLimit < 1 || newLimit > MAX_BUFFER_SIZE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "-limit must be between 1 and 65536", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", (char *)NULL); + "-limit must be between 1 and 65536", TCL_AUTO_LENGTH)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", + (char *)NULL); return TCL_ERROR; } } } if (setOptionProc == NULL) { - if (cd->format == TCL_ZLIB_FORMAT_GZIP) { + if (chanDataPtr->format == TCL_ZLIB_FORMAT_GZIP) { return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) + (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) ? gzipChanOptions : gunzipChanOptions); } else { return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) + (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) ? compressChanOptions : decompressChanOptions); } } @@ -3449,8 +3468,8 @@ ZlibTransformSetOption( /* not used */ * channel. */ - return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp, - optionName, value); + return setOptionProc(Tcl_GetChannelInstanceData(chanDataPtr->parent), + interp, optionName, value); } /* @@ -3470,9 +3489,9 @@ ZlibTransformGetOption( const char *optionName, Tcl_DString *dsPtr) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; Tcl_DriverGetOptionProc *getOptionProc = - Tcl_ChannelGetOptionProc(Tcl_GetChannelType(cd->parent)); + Tcl_ChannelGetOptionProc(Tcl_GetChannelType(chanDataPtr->parent)); static const char *compressChanOptions = "checksum dictionary"; static const char *gzipChanOptions = "checksum"; static const char *decompressChanOptions = "checksum dictionary limit"; @@ -3488,10 +3507,10 @@ ZlibTransformGetOption( uLong crc; char buf[12]; - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - crc = cd->outStream.adler; + if (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { + crc = chanDataPtr->outStream.adler; } else { - crc = cd->inStream.adler; + crc = chanDataPtr->inStream.adler; } snprintf(buf, sizeof(buf), "%lu", crc); @@ -3499,12 +3518,12 @@ ZlibTransformGetOption( Tcl_DStringAppendElement(dsPtr, "-checksum"); Tcl_DStringAppendElement(dsPtr, buf); } else { - Tcl_DStringAppend(dsPtr, buf, -1); + Tcl_DStringAppend(dsPtr, buf, TCL_AUTO_LENGTH); return TCL_OK; } } - if ((cd->format != TCL_ZLIB_FORMAT_GZIP) && + if ((chanDataPtr->format != TCL_ZLIB_FORMAT_GZIP) && (optionName == NULL || strcmp(optionName, "-dictionary") == 0)) { /* * Embedded NUL bytes are ok; they'll be C080-encoded. @@ -3512,16 +3531,17 @@ ZlibTransformGetOption( if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-dictionary"); - if (cd->compDictObj) { + if (chanDataPtr->compDictObj) { Tcl_DStringAppendElement(dsPtr, - TclGetString(cd->compDictObj)); + TclGetString(chanDataPtr->compDictObj)); } else { Tcl_DStringAppendElement(dsPtr, ""); } } else { - if (cd->compDictObj) { + if (chanDataPtr->compDictObj) { Tcl_Size length; - const char *str = TclGetStringFromObj(cd->compDictObj, &length); + const char *str = TclGetStringFromObj(chanDataPtr->compDictObj, + &length); Tcl_DStringAppend(dsPtr, str, length); } @@ -3534,12 +3554,12 @@ ZlibTransformGetOption( * reports the header that has been read from the start of the stream. */ - if ((cd->flags & IN_HEADER) && ((optionName == NULL) || + if (HaveFlag(chanDataPtr, IN_HEADER) && ((optionName == NULL) || (strcmp(optionName, "-header") == 0))) { Tcl_Obj *tmpObj; TclNewObj(tmpObj); - ExtractHeader(&cd->inHeader.header, tmpObj); + ExtractHeader(&chanDataPtr->inHeader.header, tmpObj); if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-header"); Tcl_DStringAppendElement(dsPtr, TclGetString(tmpObj)); @@ -3556,19 +3576,19 @@ ZlibTransformGetOption( */ if (getOptionProc) { - return getOptionProc(Tcl_GetChannelInstanceData(cd->parent), + return getOptionProc(Tcl_GetChannelInstanceData(chanDataPtr->parent), interp, optionName, dsPtr); } if (optionName == NULL) { return TCL_OK; } - if (cd->format == TCL_ZLIB_FORMAT_GZIP) { + if (chanDataPtr->format == TCL_ZLIB_FORMAT_GZIP) { return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) + (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) ? gzipChanOptions : gunzipChanOptions); } else { return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) + (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) ? compressChanOptions : decompressChanOptions); } } @@ -3589,21 +3609,21 @@ ZlibTransformWatch( void *instanceData, int mask) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; Tcl_DriverWatchProc *watchProc; /* * This code is based on the code in tclIORTrans.c */ - watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent)); - watchProc(Tcl_GetChannelInstanceData(cd->parent), mask); + watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(chanDataPtr->parent)); + watchProc(Tcl_GetChannelInstanceData(chanDataPtr->parent), mask); - if (!(mask & TCL_READABLE) || !(cd->flags & STREAM_DECOMPRESS)) { - ZlibTransformEventTimerKill(cd); - } else if (cd->timer == NULL) { - cd->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ZlibTransformTimerRun, cd); + if (!(mask & TCL_READABLE) || !HaveFlag(chanDataPtr, STREAM_DECOMPRESS)) { + ZlibTransformEventTimerKill(chanDataPtr); + } else if (chanDataPtr->timer == NULL) { + chanDataPtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, + ZlibTransformTimerRun, chanDataPtr); } } @@ -3612,19 +3632,19 @@ ZlibTransformEventHandler( void *instanceData, int interestMask) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; - ZlibTransformEventTimerKill(cd); + ZlibTransformEventTimerKill(chanDataPtr); return interestMask; } static inline void ZlibTransformEventTimerKill( - ZlibChannelData *cd) + ZlibChannelData *chanDataPtr) { - if (cd->timer != NULL) { - Tcl_DeleteTimerHandler(cd->timer); - cd->timer = NULL; + if (chanDataPtr->timer != NULL) { + Tcl_DeleteTimerHandler(chanDataPtr->timer); + chanDataPtr->timer = NULL; } } @@ -3632,10 +3652,10 @@ static void ZlibTransformTimerRun( void *clientData) { - ZlibChannelData *cd = (ZlibChannelData *)clientData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) clientData; - cd->timer = NULL; - Tcl_NotifyChannel(cd->chan, TCL_READABLE); + chanDataPtr->timer = NULL; + Tcl_NotifyChannel(chanDataPtr->chan, TCL_READABLE); } /* @@ -3655,9 +3675,9 @@ ZlibTransformGetHandle( int direction, void **handlePtr) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; - return Tcl_GetChannelHandle(cd->parent, direction, handlePtr); + return Tcl_GetChannelHandle(chanDataPtr->parent, direction, handlePtr); } /* @@ -3675,12 +3695,12 @@ ZlibTransformBlockMode( void *instanceData, int mode) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; if (mode == TCL_MODE_NONBLOCKING) { - cd->flags |= ASYNC; + chanDataPtr->flags |= ASYNC; } else { - cd->flags &= ~ASYNC; + chanDataPtr->flags &= ~ASYNC; } return TCL_OK; } @@ -3725,7 +3745,8 @@ ZlibStackChannelTransform( * dictionary (not dictObj!) to use if * necessary. */ { - ZlibChannelData *cd = (ZlibChannelData *)Tcl_Alloc(sizeof(ZlibChannelData)); + ZlibChannelData *chanDataPtr = (ZlibChannelData *) + Tcl_Alloc(sizeof(ZlibChannelData)); Tcl_Channel chan; int wbits = 0; @@ -3733,46 +3754,51 @@ ZlibStackChannelTransform( Tcl_Panic("unknown mode: %d", mode); } - memset(cd, 0, sizeof(ZlibChannelData)); - cd->mode = mode; - cd->format = format; - cd->readAheadLimit = limit; + memset(chanDataPtr, 0, sizeof(ZlibChannelData)); + chanDataPtr->mode = mode; + chanDataPtr->format = format; + chanDataPtr->readAheadLimit = limit; if (format == TCL_ZLIB_FORMAT_GZIP || format == TCL_ZLIB_FORMAT_AUTO) { if (mode == TCL_ZLIB_STREAM_DEFLATE) { if (gzipHeaderDictPtr) { - cd->flags |= OUT_HEADER; - if (GenerateHeader(interp, gzipHeaderDictPtr, &cd->outHeader, - NULL) != TCL_OK) { + chanDataPtr->flags |= OUT_HEADER; + if (GenerateHeader(interp, gzipHeaderDictPtr, + &chanDataPtr->outHeader, NULL) != TCL_OK) { goto error; } } } else { - cd->flags |= IN_HEADER; - cd->inHeader.header.name = (Bytef *) - &cd->inHeader.nativeFilenameBuf; - cd->inHeader.header.name_max = MAXPATHLEN - 1; - cd->inHeader.header.comment = (Bytef *) - &cd->inHeader.nativeCommentBuf; - cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1; + chanDataPtr->flags |= IN_HEADER; + chanDataPtr->inHeader.header.name = (Bytef *) + &chanDataPtr->inHeader.nativeFilenameBuf; + chanDataPtr->inHeader.header.name_max = MAXPATHLEN - 1; + chanDataPtr->inHeader.header.comment = (Bytef *) + &chanDataPtr->inHeader.nativeCommentBuf; + chanDataPtr->inHeader.header.comm_max = MAX_COMMENT_LEN - 1; } } if (compDictObj != NULL) { - cd->compDictObj = Tcl_DuplicateObj(compDictObj); - Tcl_IncrRefCount(cd->compDictObj); - Tcl_GetBytesFromObj(NULL, cd->compDictObj, (Tcl_Size *)NULL); + chanDataPtr->compDictObj = Tcl_DuplicateObj(compDictObj); + Tcl_IncrRefCount(chanDataPtr->compDictObj); + Tcl_GetBytesFromObj(NULL, chanDataPtr->compDictObj, (Tcl_Size *)NULL); } - if (format == TCL_ZLIB_FORMAT_RAW) { + switch (format) { + case TCL_ZLIB_FORMAT_RAW: wbits = WBITS_RAW; - } else if (format == TCL_ZLIB_FORMAT_ZLIB) { + break; + case TCL_ZLIB_FORMAT_ZLIB: wbits = WBITS_ZLIB; - } else if (format == TCL_ZLIB_FORMAT_GZIP) { + break; + case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; - } else if (format == TCL_ZLIB_FORMAT_AUTO) { + break; + case TCL_ZLIB_FORMAT_AUTO: wbits = WBITS_AUTODETECT; - } else { + break; + default: Tcl_Panic("bad format: %d", format); } @@ -3781,66 +3807,72 @@ ZlibStackChannelTransform( */ if (mode == TCL_ZLIB_STREAM_INFLATE) { - if (inflateInit2(&cd->inStream, wbits) != Z_OK) { + if (inflateInit2(&chanDataPtr->inStream, wbits) != Z_OK) { goto error; } - cd->inAllocated = DEFAULT_BUFFER_SIZE; - if (cd->inAllocated < cd->readAheadLimit) { - cd->inAllocated = cd->readAheadLimit; + chanDataPtr->inAllocated = DEFAULT_BUFFER_SIZE; + if (chanDataPtr->inAllocated < chanDataPtr->readAheadLimit) { + chanDataPtr->inAllocated = chanDataPtr->readAheadLimit; } - cd->inBuffer = (char *)Tcl_Alloc(cd->inAllocated); - if (cd->flags & IN_HEADER) { - if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) { + chanDataPtr->inBuffer = (char *) Tcl_Alloc(chanDataPtr->inAllocated); + if (HaveFlag(chanDataPtr, IN_HEADER)) { + if (inflateGetHeader(&chanDataPtr->inStream, + &chanDataPtr->inHeader.header) != Z_OK) { goto error; } } - if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) { - if (SetInflateDictionary(&cd->inStream, cd->compDictObj) != Z_OK) { + if (chanDataPtr->format == TCL_ZLIB_FORMAT_RAW + && chanDataPtr->compDictObj) { + if (SetInflateDictionary(&chanDataPtr->inStream, + chanDataPtr->compDictObj) != Z_OK) { goto error; } } } else { - if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits, + if (deflateInit2(&chanDataPtr->outStream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) { goto error; } - cd->outAllocated = DEFAULT_BUFFER_SIZE; - cd->outBuffer = (char *)Tcl_Alloc(cd->outAllocated); - if (cd->flags & OUT_HEADER) { - if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) { + chanDataPtr->outAllocated = DEFAULT_BUFFER_SIZE; + chanDataPtr->outBuffer = (char *) Tcl_Alloc(chanDataPtr->outAllocated); + if (HaveFlag(chanDataPtr, OUT_HEADER)) { + if (deflateSetHeader(&chanDataPtr->outStream, + &chanDataPtr->outHeader.header) != Z_OK) { goto error; } } - if (cd->compDictObj) { - if (SetDeflateDictionary(&cd->outStream, cd->compDictObj) != Z_OK) { + if (chanDataPtr->compDictObj) { + if (SetDeflateDictionary(&chanDataPtr->outStream, + chanDataPtr->compDictObj) != Z_OK) { goto error; } } } - chan = Tcl_StackChannel(interp, &zlibChannelType, cd, + chan = Tcl_StackChannel(interp, &zlibChannelType, chanDataPtr, Tcl_GetChannelMode(channel), channel); if (chan == NULL) { goto error; } - cd->chan = chan; - cd->parent = Tcl_GetStackedChannel(chan); - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); + chanDataPtr->chan = chan; + chanDataPtr->parent = Tcl_GetStackedChannel(chan); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_GetChannelName(chan), TCL_AUTO_LENGTH)); return chan; error: - if (cd->inBuffer) { - Tcl_Free(cd->inBuffer); - inflateEnd(&cd->inStream); + if (chanDataPtr->inBuffer) { + Tcl_Free(chanDataPtr->inBuffer); + inflateEnd(&chanDataPtr->inStream); } - if (cd->outBuffer) { - Tcl_Free(cd->outBuffer); - deflateEnd(&cd->outStream); + if (chanDataPtr->outBuffer) { + Tcl_Free(chanDataPtr->outBuffer); + deflateEnd(&chanDataPtr->outStream); } - if (cd->compDictObj) { - Tcl_DecrRefCount(cd->compDictObj); + if (chanDataPtr->compDictObj) { + Tcl_DecrRefCount(chanDataPtr->compDictObj); } - Tcl_Free(cd); + Tcl_Free(chanDataPtr); return NULL; } @@ -3853,18 +3885,19 @@ ZlibStackChannelTransform( * in our buffer (buf) up to toRead bytes. * * Result: - * Number of bytes decompressed or -1 if error (with *errorCodePtr updated with reason). + * Number of bytes decompressed or -1 if error (with *errorCodePtr updated + * with reason). * * Side effects: - * After execution it updates cd->inStream (next_in, avail_in) to reflect - * the data that has been decompressed. + * After execution it updates chanDataPtr->inStream (next_in, avail_in) to + * reflect the data that has been decompressed. * *---------------------------------------------------------------------- */ static int ResultDecompress( - ZlibChannelData *cd, + ZlibChannelData *chanDataPtr, char *buf, int toRead, int flush, @@ -3873,20 +3906,25 @@ ResultDecompress( int e, written, resBytes = 0; Tcl_Obj *errObj; + chanDataPtr->flags &= ~STREAM_DECOMPRESS; + chanDataPtr->inStream.next_out = (Bytef *) buf; + chanDataPtr->inStream.avail_out = toRead; + while (chanDataPtr->inStream.avail_out > 0) { + e = inflate(&chanDataPtr->inStream, flush); - cd->flags &= ~STREAM_DECOMPRESS; - cd->inStream.next_out = (Bytef *) buf; - cd->inStream.avail_out = toRead; - while (cd->inStream.avail_out > 0) { + /* + * Apply a compression dictionary if one is needed and we have one. + */ - e = inflate(&cd->inStream, flush); - if (e == Z_NEED_DICT && cd->compDictObj) { - e = SetInflateDictionary(&cd->inStream, cd->compDictObj); + if (e == Z_NEED_DICT && chanDataPtr->compDictObj) { + e = SetInflateDictionary(&chanDataPtr->inStream, + chanDataPtr->compDictObj); if (e == Z_OK) { /* - * A repetition of Z_NEED_DICT is just an error. + * A repetition of Z_NEED_DICT now is just an error. */ - e = inflate(&cd->inStream, flush); + + e = inflate(&chanDataPtr->inStream, flush); } } @@ -3895,14 +3933,14 @@ ResultDecompress( * "toRead - avail_out" is the amount of bytes generated. */ - written = toRead - cd->inStream.avail_out; + written = toRead - chanDataPtr->inStream.avail_out; /* * The cases where we're definitely done. */ if (e == Z_STREAM_END) { - cd->flags |= STREAM_DONE; + chanDataPtr->flags |= STREAM_DONE; resBytes += written; break; } @@ -3934,16 +3972,17 @@ ResultDecompress( * Check if the inflate stopped early. */ - if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) { + if (chanDataPtr->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) { break; } } - if (!(cd->flags & STREAM_DONE)) { + if (!HaveFlag(chanDataPtr, STREAM_DONE)) { /* if we have pending input data, but no available output buffer */ - if (cd->inStream.avail_in && !cd->inStream.avail_out) { + if (chanDataPtr->inStream.avail_in + && !chanDataPtr->inStream.avail_out) { /* next time try to decompress it got readable (new output buffer) */ - cd->flags |= STREAM_DECOMPRESS; + chanDataPtr->flags |= STREAM_DECOMPRESS; } } @@ -3951,12 +3990,13 @@ ResultDecompress( handleError: errObj = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1)); + Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj( + "-errorcode", TCL_AUTO_LENGTH)); Tcl_ListObjAppendElement(NULL, errObj, - ConvertErrorToList(e, cd->inStream.adler)); + ConvertErrorToList(e, chanDataPtr->inStream.adler)); Tcl_ListObjAppendElement(NULL, errObj, - Tcl_NewStringObj(cd->inStream.msg, -1)); - Tcl_SetChannelError(cd->parent, errObj); + Tcl_NewStringObj(chanDataPtr->inStream.msg, TCL_AUTO_LENGTH)); + Tcl_SetChannelError(chanDataPtr->parent, errObj); *errorCodePtr = EINVAL; return -1; } @@ -3979,7 +4019,8 @@ TclZlibInit( * commands. */ - Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", TCL_INDEX_NONE, 0); + Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", + TCL_AUTO_LENGTH, 0); /* * Create the public scripted interface to this file's functionality. @@ -4030,7 +4071,8 @@ Tcl_ZlibStreamInit( Tcl_ZlibStream *zshandle) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unimplemented", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", (char *)NULL); } return TCL_ERROR; @@ -4098,7 +4140,8 @@ Tcl_ZlibDeflate( Tcl_Obj *gzipHeaderDictObj) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unimplemented", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", (char *)NULL); } return TCL_ERROR; @@ -4113,7 +4156,8 @@ Tcl_ZlibInflate( Tcl_Obj *gzipHeaderDictObj) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unimplemented", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", (char *)NULL); } return TCL_ERROR; -- cgit v0.12 From c85963284c214c92f5053ea76ff5161a2113a2ae Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 10 May 2024 10:11:27 +0000 Subject: issue [10aa8403d064439f]: make command `testsize` platform-independent (covers constraint time64bit for unix too) --- generic/tclTest.c | 23 +++++++++++++++++++++++ win/tclWinTest.c | 23 ----------------------- 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 88e5eea..21c6d65 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -273,6 +273,7 @@ static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; +static Tcl_ObjCmdProc TestSizeCmd; static Tcl_CmdProc TeststaticpkgCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; @@ -594,6 +595,7 @@ Tcltest_Init( TestFindLastCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, NULL, NULL); Tcl_CreateCommand(interp, "testtranslatefilename", @@ -4441,6 +4443,27 @@ TestsetplatformCmd( return TCL_OK; } +static int +TestSizeCmd( + ClientData clientData, /* Unused */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const * objv) /* Parameter vector */ +{ + if (objc != 2) { + goto syntax; + } + if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) { + Tcl_StatBuf *statPtr; + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime))); + return TCL_OK; + } + +syntax: + Tcl_WrongNumArgs(interp, 1, objv, "st_mtime"); + return TCL_ERROR; +} + /* *---------------------------------------------------------------------- * diff --git a/win/tclWinTest.c b/win/tclWinTest.c index a6143c9..730eaf7 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -35,7 +35,6 @@ static Tcl_ObjCmdProc TesteventloopCmd; static Tcl_ObjCmdProc TestvolumetypeCmd; static Tcl_ObjCmdProc TestwinclockCmd; static Tcl_ObjCmdProc TestwinsleepCmd; -static Tcl_ObjCmdProc TestSizeCmd; static Tcl_ObjCmdProc TestExceptionCmd; static int TestplatformChmod(const char *nativePath, int pmode); static Tcl_ObjCmdProc TestchmodCmd; @@ -72,7 +71,6 @@ TclplatformtestInit( Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL); return TCL_OK; } @@ -307,27 +305,6 @@ TestwinsleepCmd( return TCL_OK; } -static int -TestSizeCmd( - ClientData clientData, /* Unused */ - Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Parameter count */ - Tcl_Obj *const * objv) /* Parameter vector */ -{ - if (objc != 2) { - goto syntax; - } - if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) { - Tcl_StatBuf *statPtr; - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime))); - return TCL_OK; - } - -syntax: - Tcl_WrongNumArgs(interp, 1, objv, "st_mtime"); - return TCL_ERROR; -} - /* *---------------------------------------------------------------------- * -- cgit v0.12 From 0afca9e4b664834689e45e35539016e1f48078fa Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 10 May 2024 11:28:23 +0000 Subject: Code style cleanup --- generic/tclCompile.h | 352 ++++++++++----------- generic/tclInt.h | 842 ++++++++++++++++++++++++++------------------------- 2 files changed, 619 insertions(+), 575 deletions(-) diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 5bbbb8f..18d5ed7 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -89,20 +89,20 @@ typedef enum { typedef struct { ExceptionRangeType type; /* The kind of ExceptionRange. */ - Tcl_Size nestingLevel; /* Static depth of the exception range. Used + Tcl_Size nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range * surrounding a PC at runtime. */ - Tcl_Size codeOffset; /* Offset of the first instruction byte of the + Tcl_Size codeOffset; /* Offset of the first instruction byte of the * code range. */ - Tcl_Size numCodeBytes; /* Number of bytes in the code range. */ - Tcl_Size breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC + Tcl_Size numCodeBytes; /* Number of bytes in the code range. */ + Tcl_Size breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC * offset for a break command in the range. */ - Tcl_Size continueOffset; /* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, the - * target PC offset for a continue command in - * the code range. Otherwise, ignore this + Tcl_Size continueOffset; /* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, + * the target PC offset for a continue command + * in the code range. Otherwise, ignore this * range when processing a continue * command. */ - Tcl_Size catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC + Tcl_Size catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC * offset for any "exception" in range. */ } ExceptionRange; @@ -118,11 +118,11 @@ typedef struct ExceptionAux { * one (see [for] next-clause) then we must * not pick up the range when scanning for a * target to continue to. */ - Tcl_Size stackDepth; /* The stack depth at the point where the + Tcl_Size stackDepth; /* The stack depth at the point where the * exception range was created. This is used * to calculate the number of POPs required to * restore the stack to its prior state. */ - Tcl_Size expandTarget; /* The number of expansions expected on the + Tcl_Size expandTarget; /* The number of expansions expected on the * auxData stack at the time the loop starts; * we can't currently discard them except by * doing INST_INVOKE_EXPANDED; this is a known @@ -135,23 +135,25 @@ typedef struct ExceptionAux { Tcl_Size numBreakTargets; /* The number of [break]s that want to be * targeted to the place where this loop * exception will be bound to. */ - TCL_HASH_TYPE *breakTargets; /* The offsets of the INST_JUMP4 instructions + TCL_HASH_TYPE *breakTargets;/* The offsets of the INST_JUMP4 instructions * issued by the [break]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numBreakTargets==0, this is NULL. */ Tcl_Size allocBreakTargets; /* The size of the breakTargets array. */ - Tcl_Size numContinueTargets; /* The number of [continue]s that want to be + Tcl_Size numContinueTargets;/* The number of [continue]s that want to be * targeted to the place where this loop * exception will be bound to. */ - TCL_HASH_TYPE *continueTargets; /* The offsets of the INST_JUMP4 instructions + TCL_HASH_TYPE *continueTargets; + /* The offsets of the INST_JUMP4 instructions * issued by the [continue]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numContinueTargets==0, this is NULL. */ - Tcl_Size allocContinueTargets; /* The size of the continueTargets array. */ + Tcl_Size allocContinueTargets; + /* The size of the continueTargets array. */ } ExceptionAux; /* @@ -163,10 +165,10 @@ typedef struct ExceptionAux { */ typedef struct { - Tcl_Size codeOffset; /* Offset of first byte of command code. */ - Tcl_Size numCodeBytes; /* Number of bytes for command's code. */ + Tcl_Size codeOffset; /* Offset of first byte of command code. */ + Tcl_Size numCodeBytes; /* Number of bytes for command's code. */ Tcl_Size srcOffset; /* Offset of first char of the command. */ - Tcl_Size numSrcBytes; /* Number of command source chars. */ + Tcl_Size numSrcBytes; /* Number of command source chars. */ } CmdLocation; /* @@ -182,10 +184,10 @@ typedef struct { typedef struct { Tcl_Size srcOffset; /* Command location to find the entry. */ - Tcl_Size nline; /* Number of words in the command */ - Tcl_Size *line; /* Line information for all words in the + Tcl_Size nline; /* Number of words in the command */ + Tcl_Size *line; /* Line information for all words in the * command. */ - Tcl_Size **next; /* Transient information used by the compiler + Tcl_Size **next; /* Transient information used by the compiler * for tracking of hidden continuation * lines. */ } ECL; @@ -198,8 +200,8 @@ typedef struct { Tcl_Obj *path; /* Path of the sourced file the command is * in. */ ECL *loc; /* Command word locations (lines). */ - Tcl_Size nloc; /* Number of allocated entries in 'loc'. */ - Tcl_Size nuloc; /* Number of used entries in 'loc'. */ + Tcl_Size nloc; /* Number of allocated entries in 'loc'. */ + Tcl_Size nuloc; /* Number of used entries in 'loc'. */ } ExtCmdLoc; /* @@ -217,11 +219,11 @@ typedef struct { * the AuxData structure. */ -typedef void *(AuxDataDupProc) (void *clientData); -typedef void (AuxDataFreeProc) (void *clientData); -typedef void (AuxDataPrintProc)(void *clientData, - Tcl_Obj *appendObj, struct ByteCode *codePtr, - TCL_HASH_TYPE pcOffset); +typedef void * (AuxDataDupProc) (void *clientData); +typedef void (AuxDataFreeProc) (void *clientData); +typedef void (AuxDataPrintProc) (void *clientData, + Tcl_Obj *appendObj, struct ByteCode *codePtr, + TCL_HASH_TYPE pcOffset); /* * We define a separate AuxDataType struct to hold type-related information @@ -266,7 +268,7 @@ typedef struct AuxDataType { typedef struct AuxData { const AuxDataType *type; /* Pointer to the AuxData type associated with * this ClientData. */ - void *clientData; /* The compilation data itself. */ + void *clientData; /* The compilation data itself. */ } AuxData; /* @@ -290,21 +292,23 @@ typedef struct CompileEnv { * SetByteCodeFromAny. This pointer is not * owned by the CompileEnv and must not be * freed or changed by it. */ - Tcl_Size numSrcBytes; /* Number of bytes in source. */ + Tcl_Size numSrcBytes; /* Number of bytes in source. */ Proc *procPtr; /* If a procedure is being compiled, a pointer * to its Proc structure; otherwise NULL. Used * to compile local variables. Set from * information provided by ObjInterpProc in * tclProc.c. */ - Tcl_Size numCommands; /* Number of commands compiled. */ - Tcl_Size exceptDepth; /* Current exception range nesting level; TCL_INDEX_NONE - * if not in any range currently. */ - Tcl_Size maxExceptDepth; /* Max nesting level of exception ranges; TCL_INDEX_NONE - * if no ranges have been compiled. */ - Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to + Tcl_Size numCommands; /* Number of commands compiled. */ + Tcl_Size exceptDepth; /* Current exception range nesting level; + * TCL_INDEX_NONE if not in any range + * currently. */ + Tcl_Size maxExceptDepth; /* Max nesting level of exception ranges; + * TCL_INDEX_NONE if no ranges have been + * compiled. */ + Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to * execute the code. Set by compilation * procedures before returning. */ - Tcl_Size currStackDepth; /* Current stack depth. */ + Tcl_Size currStackDepth; /* Current stack depth. */ LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl * objects referenced by this compiled code. * Indexed by the string representations of @@ -333,7 +337,7 @@ typedef struct CompileEnv { * exceptArrayNext is the number of ranges and * (exceptArrayNext-1) is the index of the * current range's array entry. */ - Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array + Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array * entry. */ #if TCL_MAJOR_VERSION < 9 int mallocedExceptArray; @@ -379,7 +383,7 @@ typedef struct CompileEnv { /* TIP #280 */ ExtCmdLoc *extCmdMapPtr; /* Extended command location information for * 'info frame'. */ - Tcl_Size line; /* First line of the script, based on the + Tcl_Size line; /* First line of the script, based on the * invoking context, then the line of the * command currently compiled. */ int atCmdStart; /* Flag to say whether an INST_START_CMD @@ -388,11 +392,11 @@ typedef struct CompileEnv { * inefficient. If set to 2, that instruction * should not be issued at all (by the generic * part of the command compiler). */ - Tcl_Size expandCount; /* Number of INST_EXPAND_START instructions + Tcl_Size expandCount; /* Number of INST_EXPAND_START instructions * encountered that have not yet been paired * with a corresponding * INST_INVOKE_EXPANDED. */ - Tcl_Size *clNext; /* If not NULL, it refers to the next slot in + Tcl_Size *clNext; /* If not NULL, it refers to the next slot in * clLoc to check for an invisible * continuation line. */ } CompileEnv; @@ -427,7 +431,7 @@ typedef struct ByteCode { * procs are specific to an interpreter so the * code emitted will depend on the * interpreter. */ - Tcl_Size compileEpoch; /* Value of iPtr->compileEpoch when this + Tcl_Size compileEpoch; /* Value of iPtr->compileEpoch when this * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ @@ -459,17 +463,17 @@ typedef struct ByteCode { * itself. Does not include heap space for * literal Tcl objects or storage referenced * by AuxData entries. */ - Tcl_Size numCommands; /* Number of commands compiled. */ - Tcl_Size numSrcBytes; /* Number of source bytes compiled. */ - Tcl_Size numCodeBytes; /* Number of code bytes. */ - Tcl_Size numLitObjects; /* Number of objects in literal array. */ + Tcl_Size numCommands; /* Number of commands compiled. */ + Tcl_Size numSrcBytes; /* Number of source bytes compiled. */ + Tcl_Size numCodeBytes; /* Number of code bytes. */ + Tcl_Size numLitObjects; /* Number of objects in literal array. */ Tcl_Size numExceptRanges; /* Number of ExceptionRange array elems. */ Tcl_Size numAuxDataItems; /* Number of AuxData items. */ - Tcl_Size numCmdLocBytes; /* Number of bytes needed for encoded command + Tcl_Size numCmdLocBytes; /* Number of bytes needed for encoded command * location information. */ - Tcl_Size maxExceptDepth; /* Maximum nesting level of ExceptionRanges; + Tcl_Size maxExceptDepth; /* Maximum nesting level of ExceptionRanges; * TCL_INDEX_NONE if no ranges were compiled. */ - Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to + Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to * execute the code. */ unsigned char *codeStart; /* Points to the first byte of the code. This * is just after the final ByteCode member @@ -525,7 +529,7 @@ typedef struct ByteCode { #endif /* TCL_COMPILE_STATS */ } ByteCode; -#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr) \ +#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (codePtr); \ @@ -533,13 +537,11 @@ typedef struct ByteCode { Tcl_StoreInternalRep((objPtr), (typePtr), &ir); \ } while (0) - - -#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \ +#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), (typePtr)); \ - (codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), (typePtr)); \ + (codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -829,11 +831,11 @@ enum TclInstruction { INST_DICT_GET_DEF, - /* TIP 461 */ - INST_STR_LT, - INST_STR_GT, - INST_STR_LE, - INST_STR_GE, + /* TIP 461 */ + INST_STR_LT, + INST_STR_GT, + INST_STR_LE, + INST_STR_GE, INST_LREPLACE4, @@ -968,8 +970,8 @@ typedef struct JumpFixup { typedef struct JumpFixupArray { JumpFixup *fixup; /* Points to start of jump fixup array. */ - Tcl_Size next; /* Index of next free array entry. */ - Tcl_Size end; /* Index of last usable entry in array. */ + Tcl_Size next; /* Index of next free array entry. */ + Tcl_Size end; /* Index of last usable entry in array. */ int mallocedArray; /* 1 if array was expanded and fixups points * into the heap, else 0. */ JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES]; @@ -985,7 +987,8 @@ typedef struct JumpFixupArray { typedef struct ForeachVarList { Tcl_Size numVars; /* The number of variables in the list. */ - Tcl_Size varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers") + Tcl_Size varIndexes[TCLFLEXARRAY]; + /* An array of the indexes ("slot numbers") * for each variable in the procedure's array * of local variables. Only scalar variables * are supported. The actual size of this @@ -1003,13 +1006,14 @@ typedef struct ForeachVarList { typedef struct ForeachInfo { Tcl_Size numLists; /* The number of both the variable and value * lists of the foreach command. */ - Tcl_Size firstValueTemp; /* Index of the first temp var in a proc frame + Tcl_Size firstValueTemp; /* Index of the first temp var in a proc frame * used to point to a value list. */ - Tcl_Size loopCtTemp; /* Index of temp var in a proc frame holding + Tcl_Size loopCtTemp; /* Index of temp var in a proc frame holding * the loop's iteration count. Used to * determine next value list element to assign * each loop var. */ - ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList + ForeachVarList *varLists[TCLFLEXARRAY]; + /* An array of pointers to ForeachVarList * structures describing each var list. The * actual size of this field will be large * enough to numVars indexes. THIS MUST BE THE @@ -1040,7 +1044,8 @@ MODULE_SCOPE const AuxDataType tclJumptableInfoType; typedef struct { Tcl_Size length; /* Size of array */ - Tcl_Size varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when + Tcl_Size varIndices[TCLFLEXARRAY]; + /* Array of variable indices to manage when * processing the start and end of a [dict * update]. There is really more than one * entry, and the structure is allocated to @@ -1200,14 +1205,13 @@ MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, Tcl_Size length, const unsigned char *pc, Tcl_Obj **tosPtr); -MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, +MODULE_SCOPE Tcl_Obj * TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); -MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); +MODULE_SCOPE Tcl_Obj * TclNewInstNameObj(unsigned char inst); MODULE_SCOPE int TclPushProcCallFrame(void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int isLambda); #endif /* TCL_MAJOR_VERSION > 8 */ - /* *---------------------------------------------------------------- @@ -1230,58 +1234,66 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, #define LITERAL_UNSHARED 0x04 /* - * Macro used to manually adjust the stack requirements; used in cases where - * the stack effect cannot be computed from the opcode and its operands, but - * is still known at compile time. - * - * void TclAdjustStackDepth(int delta, CompileEnv *envPtr); + * Adjust the stack requirements. Manually used in cases where the stack + * effect cannot be computed from the opcode and its operands, but is still + * known at compile time. */ +static inline void +TclAdjustStackDepth( + int delta, + CompileEnv *envPtr) +{ + if (delta < 0) { + if ((int) envPtr->maxStackDepth < (int) envPtr->currStackDepth) { + envPtr->maxStackDepth = envPtr->currStackDepth; + } + } + envPtr->currStackDepth += delta; +} -#define TclAdjustStackDepth(delta, envPtr) \ - do { \ - if ((delta) < 0) { \ - if ((int)(envPtr)->maxStackDepth < (int)(envPtr)->currStackDepth) { \ - (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \ - } \ - } \ - (envPtr)->currStackDepth += (delta); \ - } while (0) - -#define TclGetStackDepth(envPtr) \ +#define TclGetStackDepth(envPtr) \ ((envPtr)->currStackDepth) -#define TclSetStackDepth(depth, envPtr) \ +#define TclSetStackDepth(depth, envPtr) \ (envPtr)->currStackDepth = (depth) -#define TclCheckStackDepth(depth, envPtr) \ - do { \ - size_t _dd = (depth); \ - if (_dd != (size_t)(envPtr)->currStackDepth) { \ - Tcl_Panic("bad stack depth computations: is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u", \ - (size_t)(envPtr)->currStackDepth, _dd); \ - } \ - } while (0) +/* + * Verify that the current stack depth is what we think it should be. When + * this is wrong, code generation is broken! + */ +static inline void +TclCheckStackDepth( + size_t depth, + CompileEnv *envPtr) +{ + if (depth != (size_t) envPtr->currStackDepth) { + Tcl_Panic("bad stack depth computations: " + "is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u", + (size_t) envPtr->currStackDepth, depth); + } +} /* - * Macro used to update the stack requirements. It is called by the macros - * TclEmitOpCode, TclEmitInst1 and TclEmitInst4. + * Update the stack requirements based on the instruction definition. It is + * called by the macros TclEmitOpCode, TclEmitInst1 and TclEmitInst4. * Remark that the very last instruction of a bytecode always reduces the * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always * updated. - * - * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr); */ - -#define TclUpdateStackReqs(op, i, envPtr) \ - do { \ - int _delta = tclInstructionTable[(op)].stackEffect; \ - if (_delta) { \ - if (_delta == INT_MIN) { \ - _delta = 1 - (i); \ - } \ - TclAdjustStackDepth(_delta, envPtr); \ - } \ - } while (0) +static inline void +TclUpdateStackReqs( + unsigned char op, + int i, + CompileEnv *envPtr) +{ + int delta = tclInstructionTable[op].stackEffect; + if (delta) { + if (delta == INT_MIN) { + delta = 1 - i; + } + TclAdjustStackDepth(delta, envPtr); + } +} /* * Macros used to update the flag that indicates if we are at the start of a @@ -1291,8 +1303,8 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclUpdateAtCmdStart(op, envPtr) \ - if ((envPtr)->atCmdStart < 2) { \ - (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \ + if ((envPtr)->atCmdStart < 2) { \ + (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \ } /* @@ -1303,13 +1315,13 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclEmitOpcode(op, envPtr) \ - do { \ - if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - TclUpdateAtCmdStart(op, envPtr); \ - TclUpdateStackReqs(op, 0, envPtr); \ + do { \ + if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op); \ + TclUpdateAtCmdStart(op, envPtr); \ + TclUpdateStackReqs(op, 0, envPtr); \ } while (0) /* @@ -1365,21 +1377,21 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, } while (0) #define TclEmitInstInt4(op, i, envPtr) \ - do { \ - if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 24); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 16); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 8); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) ); \ - TclUpdateAtCmdStart(op, envPtr); \ - TclUpdateStackReqs(op, i, envPtr); \ + do { \ + if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 24); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 16); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 8); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) ); \ + TclUpdateAtCmdStart(op, envPtr); \ + TclUpdateStackReqs(op, i, envPtr); \ } while (0) /* @@ -1392,13 +1404,13 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclEmitPush(objIndex, envPtr) \ - do { \ - int _objIndexCopy = (objIndex); \ - if (_objIndexCopy <= 255) { \ - TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ - } else { \ - TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ - } \ + do { \ + int _objIndexCopy = (objIndex); \ + if (_objIndexCopy <= 255) { \ + TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ + } else { \ + TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ + } \ } while (0) /* @@ -1414,11 +1426,11 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, *(p) = (unsigned char) ((unsigned int) (i)) #define TclStoreInt4AtPtr(i, p) \ - do { \ - *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ - *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ - *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ - *(p+3) = (unsigned char) ((unsigned int) (i) ); \ + do { \ + *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ + *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ + *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ + *(p+3) = (unsigned char) ((unsigned int) (i) ); \ } while (0) /* @@ -1431,15 +1443,15 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclUpdateInstInt1AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt1AtPtr((i), ((pc)+1)); \ + do { \ + *(pc) = (unsigned char) (op); \ + TclStoreInt1AtPtr((i), ((pc)+1)); \ } while (0) #define TclUpdateInstInt4AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt4AtPtr((i), ((pc)+1)); \ + do { \ + *(pc) = (unsigned char) (op); \ + TclStoreInt4AtPtr((i), ((pc)+1)); \ } while (0) /* @@ -1486,17 +1498,17 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, #endif #define TclGetInt4AtPtr(p) \ - ((int) ((TclGetUInt1AtPtr(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ + ((int) ((TclGetUInt1AtPtr(p) << 24) | \ + (*((p)+1) << 16) | \ + (*((p)+2) << 8) | \ (*((p)+3)))) #define TclGetUInt1AtPtr(p) \ ((unsigned int) *(p)) #define TclGetUInt4AtPtr(p) \ - ((unsigned int) ((*(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ + ((unsigned int) ((*(p) << 24) | \ + (*((p)+1) << 16) | \ + (*((p)+2) << 8) | \ (*((p)+3)))) /* @@ -1517,7 +1529,7 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, * static void BODY(Tcl_Token *tokenPtr, int word); */ -#define BODY(tokenPtr, word) \ +#define BODY(tokenPtr, word) \ SetLineInformation((word)); \ TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \ envPtr) @@ -1815,14 +1827,14 @@ MODULE_SCOPE void TclDTraceOpenDebugLog(void); MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *argsi); #define TCL_DTRACE_DEBUG_LOG() \ - int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \ - int tclDTraceDebugIndent = 0; \ - FILE *tclDTraceDebugLog = NULL; \ - void TclDTraceOpenDebugLog(void) { \ - char n[35]; \ + int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \ + int tclDTraceDebugIndent = 0; \ + FILE *tclDTraceDebugLog = NULL; \ + void TclDTraceOpenDebugLog(void) { \ + char n[35]; \ snprintf(n, sizeof(n), "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \ - (size_t) getpid()); \ - tclDTraceDebugLog = fopen(n, "a"); \ + (size_t) getpid()); \ + tclDTraceDebugLog = fopen(n, "a"); \ } #define TclDTraceDbgMsg(p, m, ...) \ @@ -1849,10 +1861,10 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *args #define TCL_DTRACE_PROC_ARGS_ENABLED() 1 #define TCL_DTRACE_PROC_INFO_ENABLED() 1 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \ - tclDTraceDebugIndent++; \ + tclDTraceDebugIndent++; \ TclDTraceDbgMsg("-> proc-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2) #define TCL_DTRACE_PROC_RETURN(a0, a1) \ - TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ + TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \ TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3) @@ -1869,10 +1881,10 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *args #define TCL_DTRACE_CMD_ARGS_ENABLED() 1 #define TCL_DTRACE_CMD_INFO_ENABLED() 1 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \ - tclDTraceDebugIndent++; \ + tclDTraceDebugIndent++; \ TclDTraceDbgMsg("-> cmd-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2) #define TCL_DTRACE_CMD_RETURN(a0, a1) \ - TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ + TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \ TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3) diff --git a/generic/tclInt.h b/generic/tclInt.h index c714cb8..d6fdb88 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -257,7 +257,7 @@ typedef struct Namespace { * synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - void *clientData; /* An arbitrary value associated with this + void *clientData; /* An arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Procedure invoked when deleting the @@ -279,7 +279,7 @@ typedef struct Namespace { #else unsigned long nsId; #endif - Tcl_Interp *interp; /* The interpreter containing this + Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status * flags NS_DYING and NS_DEAD listed below. */ @@ -312,12 +312,12 @@ typedef struct Namespace { * registered using "namespace export". */ Tcl_Size maxExportPatterns; /* Number of export patterns for which space * is currently allocated. */ - Tcl_Size cmdRefEpoch; /* Incremented if a newly added command + Tcl_Size cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace * has already cached a Command* pointer; this * causes all its cached Command* pointers to * be invalidated. */ - Tcl_Size resolverEpoch; /* Incremented whenever (a) the name + Tcl_Size resolverEpoch; /* Incremented whenever (a) the name * resolution rules change for this namespace * or (b) a newly added command shadows a * command that is compiled to bytecodes. This @@ -424,8 +424,8 @@ struct NamespacePathEntry { * TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns. * TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces. * TCL_FIND_ONLY_NS - The name sought is a namespace name. - * TCL_FIND_IF_NOT_SIMPLE - Retrieve last namespace even if the rest of - * name is not simple name (contains ::). + * TCL_FIND_IF_NOT_SIMPLE - Retrieve last namespace even if the rest of + * name is not simple name (contains ::). */ #define TCL_CREATE_NS_IF_UNKNOWN 0x800 @@ -447,7 +447,7 @@ typedef struct EnsembleConfig { * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ - Tcl_Size epoch; /* The epoch at which this ensemble's table of + Tcl_Size epoch; /* The epoch at which this ensemble's table of * exported commands is valid. */ char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all * consistent points, this will have the same @@ -504,7 +504,7 @@ typedef struct EnsembleConfig { * core, presumably because the ensemble * itself has been updated. */ Tcl_Obj *parameterList; /* List of ensemble parameter names. */ - Tcl_Size numParameters; /* Cached number of parameters. This is either + Tcl_Size numParameters; /* Cached number of parameters. This is either * 0 (if the parameterList field is NULL) or * the length of the list in the parameterList * field. */ @@ -534,7 +534,7 @@ typedef struct EnsembleConfig { typedef struct VarTrace { Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by * flags are performed on variable. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_READS, TCL_TRACE_WRITES, @@ -553,7 +553,7 @@ typedef struct CommandTrace { Tcl_CommandTraceProc *traceProc; /* Procedure to call when operations given by * flags are performed on command. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ @@ -834,10 +834,10 @@ typedef struct VarInHash { #define TclVarFindHiddenArray(varPtr,arrayPtr) \ do { \ - if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ - (TclVarParentArray(varPtr) != NULL)) { \ - arrayPtr = TclVarParentArray(varPtr); \ - } \ + if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ + (TclVarParentArray(varPtr) != NULL)) { \ + arrayPtr = TclVarParentArray(varPtr); \ + } \ } while(0) #define TclIsVarScalar(varPtr) \ @@ -903,13 +903,13 @@ typedef struct VarInHash { #define TclIsVarTricky(varPtr,trickyFlags) \ ( ((varPtr)->flags & (VAR_ARRAY|VAR_LINK|trickyFlags)) \ - || (TclIsVarInHash(varPtr) \ - && (TclVarParentArray(varPtr) != NULL) \ - && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) + || (TclIsVarInHash(varPtr) \ + && (TclVarParentArray(varPtr) != NULL) \ + && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) #define TclIsVarDirectReadable(varPtr) \ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ)) \ - && (varPtr)->value.objPtr) + && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT)) @@ -919,7 +919,7 @@ typedef struct VarInHash { #define TclIsVarDirectModifyable(varPtr) \ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT)) \ - && (varPtr)->value.objPtr) + && (varPtr)->value.objPtr) #define TclIsVarDirectReadable2(varPtr, arrayPtr) \ (TclIsVarDirectReadable(varPtr) &&\ @@ -973,9 +973,9 @@ typedef struct CompiledLocal { /* Next compiler-recognized local variable for * this procedure, or NULL if this is the last * local. */ - Tcl_Size nameLength; /* The number of bytes in local variable's name. + Tcl_Size nameLength; /* The number of bytes in local variable's name. * Among others used to speed up var lookups. */ - Tcl_Size frameIndex; /* Index in the array of compiler-assigned + Tcl_Size frameIndex; /* Index in the array of compiler-assigned * variables in the procedure call frame. */ #if TCL_MAJOR_VERSION < 9 int flags; @@ -996,7 +996,7 @@ typedef struct CompiledLocal { * although only VAR_ARGUMENT, VAR_TEMPORARY, * and VAR_RESOLVED make sense. */ #endif - char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If + char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If * the name is NULL, this will just be '\0'. * The actual size of this field will be large * enough to hold the name. MUST BE THE LAST @@ -1058,7 +1058,7 @@ typedef struct Trace { #else Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */ #endif - void *clientData; /* Arbitrary value to pass to proc. */ + void *clientData; /* Arbitrary value to pass to proc. */ struct Trace *nextPtr; /* Next in list of traces for this interp. */ int flags; /* Flags governing the trace - see * Tcl_CreateObjTrace for details. */ @@ -1113,13 +1113,13 @@ MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *); /* * Abstract List * - * This structure provides the functions used in List operations to emulate a - * List for AbstractList types. + * This structure provides the functions used in List operations to emulate a + * List for AbstractList types. */ - static inline Tcl_Size -TclObjTypeLength(Tcl_Obj *objPtr) +TclObjTypeLength( + Tcl_Obj *objPtr) { Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc); return proc(objPtr); @@ -1188,15 +1188,17 @@ TclObjTypeReplace( return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs); } static inline int -TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj, - struct Tcl_Obj *listObj, int *boolResult) +TclObjTypeInOperator( + Tcl_Interp *interp, + Tcl_Obj *valueObj, + Tcl_Obj *listObj, + int *boolResult) { Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc); return proc(interp, valueObj, listObj, boolResult); } #endif /* TCL_MAJOR_VERSION > 8 */ - /* * The structure below defines an entry in the assocData hash table which is * associated with an interpreter. The entry contains a pointer to a function @@ -1206,7 +1208,7 @@ TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj, typedef struct AssocData { Tcl_InterpDeleteProc *proc; /* Proc to call when deleting. */ - void *clientData; /* Value to pass to proc. */ + void *clientData; /* Value to pass to proc. */ } AssocData; /* @@ -1250,11 +1252,10 @@ typedef struct CallFrame { * If FRAME_IS_PROC is set, the frame was * pushed to execute a Tcl procedure and may * have local vars. */ - Tcl_Size objc; /* This and objv below describe the arguments + Tcl_Size objc; /* This and objv below describe the arguments * for this procedure call. */ Tcl_Obj *const *objv; /* Array of argument objects. */ - struct CallFrame *callerPtr; - /* Value of interp->framePtr when this + struct CallFrame *callerPtr;/* Value of interp->framePtr when this * procedure was invoked (i.e. next higher in * stack of all active procedures). */ struct CallFrame *callerVarPtr; @@ -1264,7 +1265,7 @@ typedef struct CallFrame { * callerPtr unless an "uplevel" command or * something equivalent was active in the * caller). */ - Tcl_Size level; /* Level of this procedure, for "uplevel" + Tcl_Size level; /* Level of this procedure, for "uplevel" * purposes (i.e. corresponds to nesting of * callerVarPtr's, not callerPtr's). 1 for * outermost procedure, 0 for top-level. */ @@ -1284,7 +1285,7 @@ typedef struct CallFrame { * recognized by the compiler. The compiler * emits code that refers to these variables * using an index into this array. */ - void *clientData; /* Pointer to some context that is used by + void *clientData; /* Pointer to some context that is used by * object systems. The meaning of the contents * of this field is defined by the code that * sets it, and it should only ever be set by @@ -1294,8 +1295,7 @@ typedef struct CallFrame { * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; - Tcl_Obj *tailcallPtr; - /* NULL if no tailcall is scheduled */ + Tcl_Obj *tailcallPtr; /* NULL if no tailcall is scheduled */ } CallFrame; #define FRAME_IS_PROC 0x1 @@ -1384,7 +1384,7 @@ typedef struct CmdFrame { } data; Tcl_Obj *cmdObj; const char *cmd; /* The executed command, if possible... */ - Tcl_Size len; /* ... and its length. */ + Tcl_Size len; /* ... and its length. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have * ben pushed on the lineLABCPtr stack by @@ -1394,16 +1394,16 @@ typedef struct CmdFrame { typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ - Tcl_Size word; /* Index of the word in the command. */ + Tcl_Size word; /* Index of the word in the command. */ Tcl_Size refCount; /* Number of times the word is on the * stack. */ } CFWord; typedef struct CFWordBC { CmdFrame *framePtr; /* CmdFrame to access. */ - Tcl_Size pc; /* Instruction pointer of a command in + Tcl_Size pc; /* Instruction pointer of a command in * ExtCmdLoc.loc[.] */ - Tcl_Size word; /* Index of word in + Tcl_Size word; /* Index of word in * ExtCmdLoc.loc[cmd]->line[.] */ struct CFWordBC *prevPtr; /* Previous entry in stack for same Tcl_Obj. */ struct CFWordBC *nextPtr; /* Next entry for same command call. See @@ -1432,7 +1432,7 @@ typedef struct CFWordBC { #define CLL_END (-1) typedef struct ContLineLoc { - Tcl_Size num; /* Number of entries in loc, not counting the + Tcl_Size num; /* Number of entries in loc, not counting the * final -1 marker entry. */ Tcl_Size loc[TCLFLEXARRAY];/* Table of locations, as character offsets. * The table is allocated as part of the @@ -1475,14 +1475,14 @@ typedef struct ContLineLoc { typedef Tcl_Obj * (GetFrameInfoValueProc)(void *clientData); typedef struct { const char *name; /* Name of this field. */ - GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the + GetFrameInfoValueProc *proc;/* Function to generate a Tcl_Obj* from the * clientData, or just use the clientData * directly (after casting) if NULL. */ - void *clientData; /* Context for above function, or Tcl_Obj* if + void *clientData; /* Context for above function, or Tcl_Obj* if * proc field is NULL. */ } ExtraFrameInfoField; typedef struct { - Tcl_Size length; /* Length of array. */ + Tcl_Size length; /* Length of array. */ ExtraFrameInfoField fields[2]; /* Really as long as necessary, but this is * long enough for nearly anything. */ @@ -1605,22 +1605,22 @@ typedef struct CoroutineData { * the coroutine, which might be the * interpreter global environment or another * coroutine. */ - CorContext caller; - CorContext running; - Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ + CorContext caller; /* Caller's saved execution context. */ + CorContext running; /* This coroutine's saved execution context. */ + Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ void *stackLevel; - Tcl_Size auxNumLevels; /* While the coroutine is running the + Tcl_Size auxNumLevels; /* While the coroutine is running the * numLevels of the create/resume command is * stored here; for suspended coroutines it * holds the nesting numLevels at yield. */ - Tcl_Size nargs; /* Number of args required for resuming this - * coroutine; COROUTINE_ARGUMENTS_SINGLE_OPTIONAL means "0 or 1" - * (default), COROUTINE_ARGUMENTS_ARBITRARY means "any" */ + Tcl_Size nargs; /* Number of args required for resuming this + * coroutine; COROUTINE_ARGUMENTS_SINGLE_OPTIONAL + * means "0 or 1" (default), + * COROUTINE_ARGUMENTS_ARBITRARY means "any" */ Tcl_Obj *yieldPtr; /* The command to yield to. Stored here in * order to reset splice point in * TclNRCoroutineActivateCallback if the - * coroutine is busy. - */ + * coroutine is busy. */ } CoroutineData; typedef struct ExecEnv { @@ -1677,11 +1677,11 @@ typedef struct LiteralTable { LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables to avoid * mallocs and frees. */ - TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at + TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at * **buckets. */ - TCL_HASH_TYPE numEntries; /* Total number of entries present in + TCL_HASH_TYPE numEntries; /* Total number of entries present in * table. */ - TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be + TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ TCL_HASH_TYPE mask; /* Mask value used in hashing function. */ } LiteralTable; @@ -1694,10 +1694,11 @@ typedef struct LiteralTable { #ifdef TCL_COMPILE_STATS typedef struct ByteCodeStats { - size_t numExecutions; /* Number of ByteCodes executed. */ + size_t numExecutions; /* Number of ByteCodes executed. */ size_t numCompilations; /* Number of ByteCodes created. */ size_t numByteCodesFreed; /* Number of ByteCodes destroyed. */ - size_t instructionCount[256]; /* Number of times each instruction was + size_t instructionCount[256]; + /* Number of times each instruction was * executed. */ double totalSrcBytes; /* Total source bytes ever compiled. */ @@ -1705,7 +1706,7 @@ typedef struct ByteCodeStats { double currentSrcBytes; /* Src bytes for all current ByteCodes. */ double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */ - size_t srcCount[32]; /* Source size distribution: # of srcs of + size_t srcCount[32]; /* Source size distribution: # of srcs of * size [2**(n-1)..2**n), n in [0..32). */ size_t byteCodeCount[32]; /* ByteCode size distribution. */ size_t lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ @@ -1735,7 +1736,7 @@ typedef struct { Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */ CompileProc *compileProc; /* The compiler for the subcommand. */ Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */ - void *clientData; /* Any clientData to give the command. */ + void *clientData; /* Any clientData to give the command. */ int unsafe; /* Whether this command is to be hidden by * default in a safe interpreter. */ } EnsembleImplMap; @@ -1814,11 +1815,11 @@ typedef struct Command { Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */ void *objClientData; /* Arbitrary value passed to object proc. */ Tcl_CmdProc *proc; /* String-based command procedure. */ - void *clientData; /* Arbitrary value passed to string proc. */ + void *clientData; /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Procedure invoked when deleting command to, * e.g., free all client data. */ - void *deleteData; /* Arbitrary value passed to deleteProc. */ + void *deleteData; /* Arbitrary value passed to deleteProc. */ int flags; /* Miscellaneous bits of information about * command. See below for definitions. */ ImportRef *importRefPtr; /* List of each imported Command created in @@ -1857,14 +1858,13 @@ typedef struct Command { * (these last two flags are defined in tcl.h) */ -#define CMD_DYING 0x01 -#define CMD_TRACE_ACTIVE 0x02 -#define CMD_HAS_EXEC_TRACES 0x04 -#define CMD_COMPILES_EXPANDED 0x08 -#define CMD_REDEF_IN_PROGRESS 0x10 -#define CMD_VIA_RESOLVER 0x20 -#define CMD_DEAD 0x40 - +#define CMD_DYING 0x01 +#define CMD_TRACE_ACTIVE 0x02 +#define CMD_HAS_EXEC_TRACES 0x04 +#define CMD_COMPILES_EXPANDED 0x08 +#define CMD_REDEF_IN_PROGRESS 0x10 +#define CMD_VIA_RESOLVER 0x20 +#define CMD_DEAD 0x40 /* *---------------------------------------------------------------- @@ -1964,8 +1964,7 @@ typedef struct Interp { * enabled extensions check for a NULL pointer value * and for a TCL_STUBS_MAGIC value to verify they * are not [load]ing into one of those pre-stubs - * interps. - */ + * interps. */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ @@ -1975,7 +1974,7 @@ typedef struct Interp { /* Hash table used by tclBasic.c to keep track * of hidden commands on a per-interp * basis. */ - void *interpInfo; /* Information used by tclInterp.c to keep + void *interpInfo; /* Information used by tclInterp.c to keep * track of parent/child interps on a * per-interp basis. */ #if TCL_MAJOR_VERSION > 8 @@ -2054,7 +2053,7 @@ typedef struct Interp { * compiled by the interpreter. Indexed by the * string representations of literals. Used to * avoid creating duplicate objects. */ - Tcl_Size compileEpoch; /* Holds the current "compilation epoch" for + Tcl_Size compileEpoch; /* Holds the current "compilation epoch" for * this interpreter. This is incremented to * invalidate existing ByteCodes when, e.g., a * command with a compile procedure is @@ -2064,8 +2063,7 @@ typedef struct Interp { * NULL. Set by ObjInterpProc in tclProc.c and * used by tclCompile.c to process local * variables appropriately. */ - ResolverScheme *resolverPtr; - /* Linked list of name resolution schemes + ResolverScheme *resolverPtr;/* Linked list of name resolution schemes * added to this interpreter. Schemes are * added and removed by calling * Tcl_AddInterpResolvers and @@ -2100,8 +2098,8 @@ typedef struct Interp { ActiveInterpTrace *activeInterpTracePtr; /* First in list of active traces for interp, * or NULL if no active traces. */ - - Tcl_Size tracesForbiddingInline; /* Count of traces (in the list headed by + Tcl_Size tracesForbiddingInline; + /* Count of traces (in the list headed by * tracePtr) that forbid inline bytecode * compilation. */ @@ -2131,7 +2129,7 @@ typedef struct Interp { * as flag values the same as the 'active' * field. */ - Tcl_Size cmdCount; /* Limit for how many commands to execute in + Tcl_Size cmdCount; /* Limit for how many commands to execute in * the interpreter. */ LimitHandler *cmdHandlers; /* Handlers to execute when the limit is @@ -2167,9 +2165,9 @@ typedef struct Interp { * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not * processing an ensemble. */ - Tcl_Size numRemovedObjs; /* How many arguments have been stripped off + Tcl_Size numRemovedObjs;/* How many arguments have been stripped off * because of ensemble processing. */ - Tcl_Size numInsertedObjs; /* How many of the current arguments were + Tcl_Size numInsertedObjs;/* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; @@ -2208,7 +2206,7 @@ typedef struct Interp { * Proc structure for a procedure. The values * are "struct ExtCmdLoc*". (See * tclCompile.h) */ - Tcl_HashTable *lineLABCPtr; + Tcl_HashTable *lineLABCPtr; /* Tcl_Obj* (by exact pointer) -> CFWordBC* */ Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a * command on the execution stack the index of * the argument in the command, and the @@ -2229,8 +2227,7 @@ typedef struct Interp { * used by function ...() in the same file. * It does for the eval/direct path of script * execution what CompileEnv.clLoc does for - * the bytecode compiler. - */ + * the bytecode compiler. */ /* * TIP #268. The currently active selection mode, i.e. the package require * preferences. @@ -2302,7 +2299,7 @@ typedef struct Interp { Tcl_Obj *callLiteral; /* "CALL" literal for [info errorstack] */ Tcl_Obj *innerLiteral; /* "INNER" literal for [info errorstack] */ Tcl_Obj *innerContext; /* cached list for fast reallocation */ - int resetErrorStack; /* controls cleaning up of ::errorStack */ + int resetErrorStack; /* controls cleaning up of ::errorStack */ #ifdef TCL_COMPILE_STATS /* @@ -2329,10 +2326,10 @@ typedef struct Interp { #define TclCanceled(iPtr) \ (((iPtr)->flags & CANCELED) || ((iPtr)->flags & TCL_CANCEL_UNWIND)) -#define TclSetCancelFlags(iPtr, cancelFlags) \ - (iPtr)->flags |= CANCELED; \ - if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ - (iPtr)->flags |= TCL_CANCEL_UNWIND; \ +#define TclSetCancelFlags(iPtr, cancelFlags) \ + (iPtr)->flags |= CANCELED; \ + if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ + (iPtr)->flags |= TCL_CANCEL_UNWIND; \ } #define TclUnsetCancelFlags(iPtr) \ @@ -2494,7 +2491,8 @@ struct TclMaxAlignment { */ #define TclOOM(ptr, size) \ - ((size) && ((ptr)||(Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)),1))) + ((size) && ((ptr) || (Tcl_Panic( \ + "unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)), 1))) /* * The following enum values are used to specify the runtime platform setting @@ -2564,36 +2562,38 @@ typedef enum TclEolTranslation { * */ typedef struct ListStore { - Tcl_Size firstUsed; /* Index of first slot in use within slots[] */ - Tcl_Size numUsed; /* Number of slots in use (starting firstUsed) */ - Tcl_Size numAllocated; /* Total number of slots[] array slots. */ - size_t refCount; /* Number of references to this instance */ - int flags; /* LISTSTORE_* flags */ - Tcl_Obj *slots[TCLFLEXARRAY]; /* Variable size array. Grown as needed */ + Tcl_Size firstUsed; /* Index of first slot in use within slots[] */ + Tcl_Size numUsed; /* Number of slots in use (starting firstUsed) */ + Tcl_Size numAllocated; /* Total number of slots[] array slots. */ + size_t refCount; /* Number of references to this instance. */ + int flags; /* LISTSTORE_* flags */ + Tcl_Obj *slots[TCLFLEXARRAY]; + /* Variable size array. Grown as needed */ } ListStore; #define LISTSTORE_CANONICAL 0x1 /* All Tcl_Obj's referencing this - store have their string representation - derived from the list representation */ + * store have their string representation + * derived from the list representation */ /* Max number of elements that can be contained in a list */ -#define LIST_MAX \ - ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \ - / sizeof(Tcl_Obj *))) +#define LIST_MAX \ + ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \ + / sizeof(Tcl_Obj *))) /* Memory size needed for a ListStore to hold numSlots_ elements */ #define LIST_SIZE(numSlots_) \ - ((Tcl_Size)(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *)))) + ((Tcl_Size)(offsetof(ListStore, slots) \ + + ((numSlots_) * sizeof(Tcl_Obj *)))) /* * ListSpan -- * See comments above for ListStore */ typedef struct ListSpan { - Tcl_Size spanStart; /* Starting index of the span */ - Tcl_Size spanLength; /* Number of elements in the span */ - size_t refCount; /* Count of references to this span record */ + Tcl_Size spanStart; /* Starting index of the span. */ + Tcl_Size spanLength; /* Number of elements in the span. */ + size_t refCount; /* Count of references to this span record. */ } ListSpan; -#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */ +#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */ #define LIST_SPAN_THRESHOLD 101 #endif @@ -2602,9 +2602,11 @@ typedef struct ListSpan { * See comments above for ListStore */ typedef struct ListRep { - ListStore *storePtr;/* element array shared amongst different lists */ - ListSpan *spanPtr; /* If not NULL, the span holds the range of slots - within *storePtr that contain this list elements. */ + ListStore *storePtr; /* element array shared amongst different + * lists */ + ListSpan *spanPtr; /* If not NULL, the span holds the range of + * slots within *storePtr that contain this + * list elements. */ } ListRep; /* @@ -2620,14 +2622,16 @@ typedef struct ListRep { */ /* Returns the starting slot for this listRep in the contained ListStore */ -#define ListRepStart(listRepPtr_) \ - ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanStart \ - : (listRepPtr_)->storePtr->firstUsed) +#define ListRepStart(listRepPtr_) \ + ((listRepPtr_)->spanPtr \ + ? (listRepPtr_)->spanPtr->spanStart \ + : (listRepPtr_)->storePtr->firstUsed) /* Returns the number of elements in this listRep */ -#define ListRepLength(listRepPtr_) \ - ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanLength \ - : (listRepPtr_)->storePtr->numUsed) +#define ListRepLength(listRepPtr_) \ + ((listRepPtr_)->spanPtr \ + ? (listRepPtr_)->spanPtr->spanLength \ + : (listRepPtr_)->storePtr->numUsed) /* Returns a pointer to the first slot containing this ListRep elements */ #define ListRepElementsBase(listRepPtr_) \ @@ -2635,7 +2639,7 @@ typedef struct ListRep { /* Stores the number of elements and base address of the element array */ #define ListRepElements(listRepPtr_, objc_, objv_) \ - (((objv_) = ListRepElementsBase(listRepPtr_)), \ + (((objv_) = ListRepElementsBase(listRepPtr_)), \ ((objc_) = ListRepLength(listRepPtr_))) /* Returns 1/0 whether the ListRep's ListStore is shared. */ @@ -2650,34 +2654,36 @@ typedef struct ListRep { ((ListSpan *)((listObj_)->internalRep.twoPtrValue.ptr2)) /* Returns the ListRep internal representaton in a Tcl_Obj */ -#define ListObjGetRep(listObj_, listRepPtr_) \ - do { \ - (listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \ - (listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_); \ +#define ListObjGetRep(listObj_, listRepPtr_) \ + do { \ + (listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \ + (listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_); \ } while (0) /* Returns the length of the list */ -#define ListObjLength(listObj_, len_) \ - ((len_) = ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanLength \ - : ListObjStorePtr(listObj_)->numUsed) +#define ListObjLength(listObj_, len_) \ + ((len_) = ListObjSpanPtr(listObj_) \ + ? ListObjSpanPtr(listObj_)->spanLength \ + : ListObjStorePtr(listObj_)->numUsed) /* Returns the starting slot index of this list's elements in the ListStore */ -#define ListObjStart(listObj_) \ - (ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanStart \ - : ListObjStorePtr(listObj_)->firstUsed) +#define ListObjStart(listObj_) \ + (ListObjSpanPtr(listObj_) \ + ? ListObjSpanPtr(listObj_)->spanStart \ + : ListObjStorePtr(listObj_)->firstUsed) /* Stores the element count and base address of this list's elements */ #define ListObjGetElements(listObj_, objc_, objv_) \ (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \ (ListObjLength(listObj_, (objc_)))) - /* * Returns 1/0 whether the internal representation (not the Tcl_Obj itself) * is shared. Note by intent this only checks for sharing of ListStore, * not spans. */ -#define ListObjRepIsShared(listObj_) (ListObjStorePtr(listObj_)->refCount > 1) +#define ListObjRepIsShared(listObj_) \ + (ListObjStorePtr(listObj_)->refCount > 1) /* * Certain commands like concat are optimized if an existing string @@ -2694,10 +2700,10 @@ typedef struct ListRep { * and never from strings (see SetListFromAny) and thus their string * representation will always be canonical. */ -#define ListObjIsCanonical(listObj_) \ - (((listObj_)->bytes == NULL) \ - || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \ - || ListObjSpanPtr(listObj_) != NULL) +#define ListObjIsCanonical(listObj_) \ + (((listObj_)->bytes == NULL) \ + || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \ + || ListObjSpanPtr(listObj_) != NULL) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element @@ -2705,25 +2711,27 @@ typedef struct ListRep { * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be * converted to a list. */ -#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ - TCL_OK) \ - : Tcl_ListObjGetElements( \ - (interp_), (listObj_), (objcPtr_), (objvPtr_))) +#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ + TCL_OK) \ + : Tcl_ListObjGetElements( \ + (interp_), (listObj_), (objcPtr_), (objvPtr_))) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element * count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the * Tcl_Obj cannot be converted to a list. */ -#define TclListObjLength(interp_, listObj_, lenPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ - : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) +#define TclListObjLength(interp_, listObj_, lenPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ + : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) #define TclListObjIsCanonical(listObj_) \ - ((TclHasInternalRep((listObj_), &tclListType)) ? ListObjIsCanonical((listObj_)) : 0) + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ListObjIsCanonical((listObj_)) \ + : 0) /* * Modes for collecting (or not) in the implementations of TclNRForeachCmd, @@ -2743,44 +2751,45 @@ typedef struct ListRep { #if TCL_MAJOR_VERSION > 8 #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ - || TclHasInternalRep((objPtr), &tclBooleanType)) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ + || TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #else #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ + ((TclHasInternalRep((objPtr), &tclIntType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ - : (TclHasInternalRep((objPtr), &tclBooleanType)) \ + : (TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #endif #ifdef TCL_WIDE_INT_IS_LONG #define TclGetLongFromObj(interp, objPtr, longPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ - ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) + ((TclHasInternalRep((objPtr), &tclIntType)) \ + ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #else #define TclGetLongFromObj(interp, objPtr, longPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \ - ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) + ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #endif #define TclGetIntFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ - ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) + ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ - (((TclHasInternalRep((objPtr), &tclIntType)) && ((objPtr)->internalRep.wideValue >= 0) \ - && ((objPtr)->internalRep.wideValue <= endValue)) \ - ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) + (((TclHasInternalRep((objPtr), &tclIntType)) \ + && ((objPtr)->internalRep.wideValue >= 0) \ + && ((objPtr)->internalRep.wideValue <= endValue)) \ + ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* * Macro used to save a function call for common uses of @@ -2791,10 +2800,9 @@ typedef struct ListRep { */ #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ - ? (*(wideIntPtr) = \ - ((objPtr)->internalRep.wideValue), TCL_OK) : \ - Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) + ((TclHasInternalRep((objPtr), &tclIntType)) \ + ? (*(wideIntPtr) = ((objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) /* * Flag values for TclTraceDictPath(). @@ -2839,7 +2847,8 @@ typedef struct ListRep { #define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2) typedef void *(TclFSGetCwdProc2)(void *clientData); typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr, - Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); + Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, + int flags); /* * The following types are used for getting and storing platform-specific file @@ -2890,13 +2899,14 @@ typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp, *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, TCL_HASH_TYPE *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, + TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr); #ifdef _WIN32 # define TCLFSENCODING tclUtf8Encoding /* On Windows, all Unicode (except surrogates) are valid */ #else -# define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */ +# define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */ #endif /* @@ -2908,7 +2918,7 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, TCL_HASH_TYPE *len */ typedef struct ProcessGlobalValue { - Tcl_Size epoch; /* Epoch counter to detect changes in the + Tcl_Size epoch; /* Epoch counter to detect changes in the * global value. */ TCL_HASH_TYPE numBytes; /* Length of the global string. */ char *value; /* The global string value. */ @@ -2930,26 +2940,25 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------------- */ -#define TCL_PARSE_DECIMAL_ONLY 1 +#define TCL_PARSE_DECIMAL_ONLY 1 /* Leading zero doesn't denote octal or * hex. */ -#define TCL_PARSE_OCTAL_ONLY 2 +#define TCL_PARSE_OCTAL_ONLY 2 /* Parse octal even without prefix. */ #define TCL_PARSE_HEXADECIMAL_ONLY 4 /* Parse hexadecimal even without prefix. */ -#define TCL_PARSE_INTEGER_ONLY 8 +#define TCL_PARSE_INTEGER_ONLY 8 /* Disable floating point parsing. */ -#define TCL_PARSE_SCAN_PREFIXES 16 +#define TCL_PARSE_SCAN_PREFIXES 16 /* Use [scan] rules dealing with 0? * prefixes. */ -#define TCL_PARSE_NO_WHITESPACE 32 +#define TCL_PARSE_NO_WHITESPACE 32 /* Reject leading/trailing whitespace. */ #define TCL_PARSE_BINARY_ONLY 64 /* Parse binary even without prefix. */ #define TCL_PARSE_NO_UNDERSCORE 128 /* Reject underscore digit separator */ - /* *---------------------------------------------------------------------- * Internal convenience macros for manipulating encoding flags. See @@ -2958,11 +2967,12 @@ typedef struct ProcessGlobalValue { */ #define ENCODING_PROFILE_MASK 0xFF000000 -#define ENCODING_PROFILE_GET(flags_) ((flags_) & ENCODING_PROFILE_MASK) -#define ENCODING_PROFILE_SET(flags_, profile_) \ - do { \ - (flags_) &= ~ENCODING_PROFILE_MASK; \ - (flags_) |= ((profile_) & ENCODING_PROFILE_MASK);\ +#define ENCODING_PROFILE_GET(flags_) \ + ((flags_) & ENCODING_PROFILE_MASK) +#define ENCODING_PROFILE_SET(flags_, profile_) \ + do { \ + (flags_) &= ~ENCODING_PROFILE_MASK; \ + (flags_) |= ((profile_) & ENCODING_PROFILE_MASK); \ } while (0) /* @@ -2977,22 +2987,26 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------------- */ static inline Tcl_Size -TclUpsizeAlloc(TCL_UNUSED(Tcl_Size) /* oldSize. For future experiments with - * some growth algorithms that use this - * information. */, - Tcl_Size needed, - Tcl_Size limit) +TclUpsizeAlloc( + TCL_UNUSED(Tcl_Size), /* oldSize. For future experiments with + * some growth algorithms that use this + * information. */ + Tcl_Size needed, + Tcl_Size limit) { /* assert (oldCapacity < needed <= limit) */ if (needed < (limit - needed/2)) { return needed + needed / 2; - } - else { + } else { return limit; } } -static inline Tcl_Size TclUpsizeRetry(Tcl_Size needed, Tcl_Size lastAttempt) { - /* assert (needed < lastAttempt) */ +static inline Tcl_Size +TclUpsizeRetry( + Tcl_Size needed, + Tcl_Size lastAttempt) +{ + /* assert(needed < lastAttempt); */ if (needed < lastAttempt - 1) { /* (needed+lastAttempt)/2 but that formula may overflow Tcl_Size */ return needed + (lastAttempt - needed) / 2; @@ -3000,37 +3014,58 @@ static inline Tcl_Size TclUpsizeRetry(Tcl_Size needed, Tcl_Size lastAttempt) { return needed; } } -MODULE_SCOPE void *TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr); -MODULE_SCOPE void *TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount, - Tcl_Size elemSize, Tcl_Size leadSize, - Tcl_Size *capacityPtr); -MODULE_SCOPE void *TclAttemptReallocElemsEx(void *oldPtr, - Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr); +MODULE_SCOPE void * TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, + Tcl_Size leadSize, Tcl_Size *capacityPtr); +MODULE_SCOPE void * TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount, + Tcl_Size elemSize, Tcl_Size leadSize, + Tcl_Size *capacityPtr); +MODULE_SCOPE void * TclAttemptReallocElemsEx(void *oldPtr, + Tcl_Size elemCount, Tcl_Size elemSize, + Tcl_Size leadSize, Tcl_Size *capacityPtr); /* Alloc elemCount elements of size elemSize with leadSize header * returning actual capacity (in elements) in *capacityPtr. */ -static inline void *TclAttemptAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr) { +static inline void * +TclAttemptAllocElemsEx( + Tcl_Size elemCount, + Tcl_Size elemSize, + Tcl_Size leadSize, + Tcl_Size *capacityPtr) +{ return TclAttemptReallocElemsEx( - NULL, elemCount, elemSize, leadSize, capacityPtr); + NULL, elemCount, elemSize, leadSize, capacityPtr); } /* Alloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclAllocEx( + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclAllocElemsEx(numBytes, 1, 0, capacityPtr); } /* Alloc numByte bytes, returning actual capacity in *capacityPtr. */ static inline void * -TclAttemptAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) +TclAttemptAllocEx( + Tcl_Size numBytes, + Tcl_Size *capacityPtr) { return TclAttemptAllocElemsEx(numBytes, 1, 0, capacityPtr); } /* Realloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclReallocEx( + void *oldPtr, + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr); } /* Realloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclAttemptReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclAttemptReallocEx( + void *oldPtr, + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclAttemptReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr); } @@ -3051,13 +3086,12 @@ MODULE_SCOPE TclPlatformType tclPlatform; MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; MODULE_SCOPE Tcl_Encoding tclUtf8Encoding; -MODULE_SCOPE int -TclEncodingProfileNameToId(Tcl_Interp *interp, - const char *profileName, - int *profilePtr); +MODULE_SCOPE int TclEncodingProfileNameToId(Tcl_Interp *interp, + const char *profileName, + int *profilePtr); MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp, - int profileId); -MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); + int profileId); +MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); /* * TIP #233 (Virtualized Time) @@ -3155,12 +3189,13 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke; MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues; -MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); -MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); +MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, + Tcl_Obj *tailcallPtr); +MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); /* These two can be considered for the public api */ -MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); -MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); /* * This structure holds the data for the various iteration callbacks used to @@ -3177,7 +3212,7 @@ typedef struct ForIterData { Tcl_Obj *body; /* Loop body. */ Tcl_Obj *next; /* Loop step script, NULL for 'while'. */ const char *msg; /* Error message part. */ - Tcl_Size word; /* Index of the body script in the command */ + Tcl_Size word; /* Index of the body script in the command */ } ForIterData; /* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile @@ -3185,9 +3220,9 @@ typedef struct ForIterData { * typedef in tcl.h */ typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, - const char* symbol); + const char* symbol); struct Tcl_LoadHandle_ { - void *clientData; /* Client data is the load handle in the + void *clientData; /* Client data is the load handle in the * native filesystem if a module was loaded * there, or an opaque pointer to a structure * for further bookkeeping on load-from-VFS @@ -3201,16 +3236,12 @@ struct Tcl_LoadHandle_ { /* Flags for conversion of doubles to digit strings */ -#define TCL_DD_E_FORMAT 0x2 - /* Use a fixed-length string of digits, +#define TCL_DD_E_FORMAT 0x2 /* Use a fixed-length string of digits, * suitable for E format*/ -#define TCL_DD_F_FORMAT 0x3 - /* Use a fixed number of digits after the +#define TCL_DD_F_FORMAT 0x3 /* Use a fixed number of digits after the * decimal point, suitable for F format */ -#define TCL_DD_SHORTEST 0x4 - /* Use the shortest possible string */ -#define TCL_DD_NO_QUICK 0x8 - /* Debug flag: forbid quick FP conversion */ +#define TCL_DD_SHORTEST 0x4 /* Use the shortest possible string */ +#define TCL_DD_NO_QUICK 0x8 /* Debug flag: forbid quick FP conversion */ #define TCL_DD_CONVERSION_TYPE_MASK 0x3 /* Mask to isolate the conversion type */ @@ -3236,7 +3267,8 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, Tcl_Obj *objv[], int objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, - void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc); + void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, + Tcl_Size pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, @@ -3309,7 +3341,8 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp, - Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size *objcPtr); + Tcl_Obj *const *objv, Tcl_Size objc, + Tcl_Size *objcPtr); MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp); MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); @@ -3424,7 +3457,7 @@ MODULE_SCOPE Tcl_Size TclMaxListLength(const char *bytes, Tcl_Size numBytes, MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr); -MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); +MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); MODULE_SCOPE int TclNokia770Doubles(void); MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr); @@ -3449,15 +3482,16 @@ MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, MODULE_SCOPE void TclUndoRefCount(Tcl_Obj *objPtr); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); -MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, +MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); -MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr, - int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, - Tcl_Obj *stepObj, Tcl_Obj *lenObj); +MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, + Tcl_Obj **arithSeriesPtr, + int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, + Tcl_Obj *stepObj, Tcl_Obj *lenObj); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, Tcl_Size len); MODULE_SCOPE void TclpAlertNotifier(void *clientData); -MODULE_SCOPE void *TclpNotifierData(void); +MODULE_SCOPE void * TclpNotifierData(void); MODULE_SCOPE void TclpServiceModeHook(int mode); MODULE_SCOPE void TclpSetTimer(const Tcl_Time *timePtr); MODULE_SCOPE int TclpWaitForEvent(const Tcl_Time *timePtr); @@ -3487,7 +3521,7 @@ MODULE_SCOPE Tcl_Size TclpFindVariable(const char *name, Tcl_Size *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); -MODULE_SCOPE void *TclpInitNotifier(void); +MODULE_SCOPE void * TclpInitNotifier(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void); @@ -3569,13 +3603,14 @@ MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Size count, int *tokensLeftPtr, Tcl_Size line, Tcl_Size *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_Size TclTrim(const char *bytes, Tcl_Size numBytes, - const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight); + const char *trim, Tcl_Size numTrim, + Tcl_Size *trimRight); MODULE_SCOPE Tcl_Size TclTrimLeft(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE Tcl_Size TclTrimRight(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); -MODULE_SCOPE int TclObjInterpProc(void *clientData, +MODULE_SCOPE int TclObjInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclRegisterCommandTypeName( @@ -3601,16 +3636,16 @@ MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); #ifdef TCL_WIDE_CLICKS -MODULE_SCOPE long long TclpGetWideClicks(void); +MODULE_SCOPE long long TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(long long clicks); MODULE_SCOPE double TclpWideClickInMicrosec(void); #else # ifdef _WIN32 # define TCL_WIDE_CLICKS 1 -MODULE_SCOPE long long TclpGetWideClicks(void); +MODULE_SCOPE long long TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClickInMicrosec(void); -# define TclpWideClicksToNanoseconds(clicks) \ - ((double)(clicks) * TclpWideClickInMicrosec() * 1000) +# define TclpWideClicksToNanoseconds(clicks) \ + ((double)(clicks) * TclpWideClickInMicrosec() * 1000) # endif #endif MODULE_SCOPE long long TclpGetMicroseconds(void); @@ -3634,8 +3669,8 @@ MODULE_SCOPE void TclZipfsFinalize(void); */ MODULE_SCOPE int TclIsSpaceProc(int byte); -# define TclIsSpaceProcM(byte) \ - (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte)) +#define TclIsSpaceProcM(byte) \ + (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte)) /* *---------------------------------------------------------------- @@ -4004,14 +4039,13 @@ MODULE_SCOPE int TclFullFinalizationRequested(void); * TIP #542 */ -MODULE_SCOPE size_t TclUniCharLen(const Tcl_UniChar *uniStr); -MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); -MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); -MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, - const Tcl_UniChar *uniPattern, int nocase); - +MODULE_SCOPE size_t TclUniCharLen(const Tcl_UniChar *uniStr); +MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, + const Tcl_UniChar *uniPattern, int nocase); /* * Just for the purposes of command-type registration. @@ -4070,13 +4104,14 @@ MODULE_SCOPE Tcl_Size TclIndexDecode(int encoded, Tcl_Size endValue); /* * Error message utility functions */ -MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count); +MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, + Tcl_Size count); #endif /* TCL_MAJOR_VERSION > 8 */ /* Constants used in index value encoding routines. */ -#define TCL_INDEX_END ((Tcl_Size)-2) -#define TCL_INDEX_START ((Tcl_Size)0) +#define TCL_INDEX_END ((Tcl_Size)-2) +#define TCL_INDEX_START ((Tcl_Size)0) /* *---------------------------------------------------------------------- @@ -4155,20 +4190,20 @@ TclScaleTime( # define TclIncrObjsFreed() #endif /* TCL_COMPILE_STATS */ -# define TclAllocObjStorage(objPtr) \ +# define TclAllocObjStorage(objPtr) \ TclAllocObjStorageEx(NULL, (objPtr)) -# define TclFreeObjStorage(objPtr) \ +# define TclFreeObjStorage(objPtr) \ TclFreeObjStorageEx(NULL, (objPtr)) #ifndef TCL_MEM_DEBUG # define TclNewObj(objPtr) \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = &tclEmptyString; \ - (objPtr)->length = 0; \ - (objPtr)->typePtr = NULL; \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = &tclEmptyString; \ + (objPtr)->length = 0; \ + (objPtr)->typePtr = NULL; \ TCL_DTRACE_OBJ_CREATE(objPtr) /* @@ -4179,19 +4214,19 @@ TclScaleTime( */ # define TclDecrRefCount(objPtr) \ - if ((objPtr)->refCount-- > 1) ; else { \ - if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ - TCL_DTRACE_OBJ_FREE(objPtr); \ - if ((objPtr)->bytes \ - && ((objPtr)->bytes != &tclEmptyString)) { \ - Tcl_Free((objPtr)->bytes); \ - } \ - (objPtr)->length = TCL_INDEX_NONE; \ - TclFreeObjStorage(objPtr); \ - TclIncrObjsFreed(); \ - } else { \ - TclFreeObj(objPtr); \ - } \ + if ((objPtr)->refCount-- > 1) ; else { \ + if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ + TCL_DTRACE_OBJ_FREE(objPtr); \ + if ((objPtr)->bytes \ + && ((objPtr)->bytes != &tclEmptyString)) { \ + Tcl_Free((objPtr)->bytes); \ + } \ + (objPtr)->length = TCL_INDEX_NONE; \ + TclFreeObjStorage(objPtr); \ + TclIncrObjsFreed(); \ + } else { \ + TclFreeObj(objPtr); \ + } \ } #if TCL_THREADS && !defined(USE_THREAD_ALLOC) @@ -4298,11 +4333,11 @@ MODULE_SCOPE Tcl_Mutex tclObjMutex; } while (0) # define TclFreeObjStorageEx(interp, objPtr) \ - do { \ - Tcl_MutexLock(&tclObjMutex); \ + do { \ + Tcl_MutexLock(&tclObjMutex); \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \ - tclFreeObjList = (objPtr); \ - Tcl_MutexUnlock(&tclObjMutex); \ + tclFreeObjList = (objPtr); \ + Tcl_MutexUnlock(&tclObjMutex); \ } while (0) #endif @@ -4353,27 +4388,26 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclInitEmptyStringRep(objPtr) \ - ((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0)) - + ((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0)) #define TclInitStringRep(objPtr, bytePtr, len) \ - if ((len) == 0) { \ - TclInitEmptyStringRep(objPtr); \ - } else { \ - (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \ + if ((len) == 0) { \ + TclInitEmptyStringRep(objPtr); \ + } else { \ + (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \ memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \ - (objPtr)->bytes[len] = '\0'; \ - (objPtr)->length = (len); \ + (objPtr)->bytes[len] = '\0'; \ + (objPtr)->length = (len); \ } #define TclAttemptInitStringRep(objPtr, bytePtr, len) \ - ((((len) == 0) ? ( \ - TclInitEmptyStringRep(objPtr) \ - ) : ( \ - (objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \ - (objPtr)->length = ((objPtr)->bytes) ? \ + ((((len) == 0) ? ( \ + TclInitEmptyStringRep(objPtr) \ + ) : ( \ + (objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \ + (objPtr)->length = ((objPtr)->bytes) ? \ (memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)), \ - (objPtr)->bytes[len] = '\0', (len)) : (-1) \ + (objPtr)->bytes[len] = '\0', (len)) : (-1) \ )), (objPtr)->bytes) /* @@ -4392,8 +4426,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) #define TclGetStringFromObj(objPtr, lenPtr) \ - ((objPtr)->bytes \ - ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ + ((objPtr)->bytes \ + ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ : (Tcl_GetStringFromObj)((objPtr), (lenPtr))) /* @@ -4407,11 +4441,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclFreeInternalRep(objPtr) \ - if ((objPtr)->typePtr != NULL) { \ - if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ - (objPtr)->typePtr->freeIntRepProc(objPtr); \ - } \ - (objPtr)->typePtr = NULL; \ + if ((objPtr)->typePtr != NULL) { \ + if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ + (objPtr)->typePtr->freeIntRepProc(objPtr); \ + } \ + (objPtr)->typePtr = NULL; \ } /* @@ -4424,14 +4458,14 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclInvalidateStringRep(objPtr) \ - do { \ - Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ - if (_isobjPtr->bytes != NULL) { \ - if (_isobjPtr->bytes != &tclEmptyString) { \ - Tcl_Free((char *)_isobjPtr->bytes); \ - } \ - _isobjPtr->bytes = NULL; \ - } \ + do { \ + Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ + if (_isobjPtr->bytes != NULL) { \ + if (_isobjPtr->bytes != &tclEmptyString) { \ + Tcl_Free((char *)_isobjPtr->bytes); \ + } \ + _isobjPtr->bytes = NULL; \ + } \ } while (0) /* @@ -4474,8 +4508,8 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; #define TclUnpackBignum(objPtr, bignum) \ do { \ - Tcl_Obj *bignumObj = (objPtr); \ - int bignumPayload = \ + Tcl_Obj *bignumObj = (objPtr); \ + int bignumPayload = \ PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \ if (bignumPayload == -1) { \ (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \ @@ -4528,16 +4562,16 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; oldPtr = NULL; \ } \ newPtr = (Tcl_Token *)Tcl_AttemptRealloc((char *) oldPtr, \ - allocated * sizeof(Tcl_Token)); \ + allocated * sizeof(Tcl_Token)); \ if (newPtr == NULL) { \ allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH; \ newPtr = (Tcl_Token *)Tcl_Realloc((char *) oldPtr, \ - allocated * sizeof(Tcl_Token)); \ + allocated * sizeof(Tcl_Token)); \ } \ (available) = allocated; \ if (oldPtr == NULL) { \ memcpy(newPtr, staticPtr, \ - (used) * sizeof(Tcl_Token)); \ + (used) * sizeof(Tcl_Token)); \ } \ (tokenPtr) = newPtr; \ } \ @@ -4561,8 +4595,8 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; */ #define TclUtfToUniChar(str, chPtr) \ - (((UCHAR(*(str))) < 0x80) ? \ - ((*(chPtr) = UCHAR(*(str))), 1) \ + (((UCHAR(*(str))) < 0x80) ? \ + ((*(chPtr) = UCHAR(*(str))), 1) \ : Tcl_UtfToUniChar(str, chPtr)) /* @@ -4579,15 +4613,15 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; */ #define TclNumUtfCharsM(numChars, bytes, numBytes) \ - do { \ - Tcl_Size _count, _i = (numBytes); \ - unsigned char *_str = (unsigned char *) (bytes); \ - while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ - _count = (numBytes) - _i; \ - if (_i) { \ - _count += Tcl_NumUtfChars((bytes) + _count, _i); \ - } \ - (numChars) = _count; \ + do { \ + Tcl_Size _count, _i = (numBytes); \ + unsigned char *_str = (unsigned char *) (bytes); \ + while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ + _count = (numBytes) - _i; \ + if (_i) { \ + _count += Tcl_NumUtfChars((bytes) + _count, _i); \ + } \ + (numChars) = _count; \ } while (0); /* @@ -4607,12 +4641,11 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ - (((objPtr)->bytes==NULL) && TclHasInternalRep((objPtr), &tclDictType)) + (((objPtr)->bytes == NULL) && TclHasInternalRep((objPtr), &tclDictType)) #define TclHasInternalRep(objPtr, type) \ - ((objPtr)->typePtr == (type)) + ((objPtr)->typePtr == (type)) #define TclFetchInternalRep(objPtr, type) \ - (TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL) - + (TclHasInternalRep((objPtr), (type)) ? &(objPtr)->internalRep : NULL) /* *---------------------------------------------------------------- @@ -4658,7 +4691,6 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init; MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; - /* *---------------------------------------------------------------- * Macro used by the Tcl core to check whether a pattern has any characters @@ -4684,18 +4716,18 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; */ #define TclSetIntObj(objPtr, i) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.wideValue = (Tcl_WideInt) i; \ - TclInvalidateStringRep(objPtr); \ - Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.wideValue = (Tcl_WideInt) i; \ + TclInvalidateStringRep(objPtr); \ + Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \ } while (0) #define TclSetDoubleObj(objPtr, d) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.doubleValue = (double) d; \ - TclInvalidateStringRep(objPtr); \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.doubleValue = (double) d; \ + TclInvalidateStringRep(objPtr); \ Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir); \ } while (0) @@ -4715,58 +4747,58 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; #ifndef TCL_MEM_DEBUG #define TclNewIntObj(objPtr, w) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ - (objPtr)->typePtr = &tclIntType; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ + (objPtr)->typePtr = &tclIntType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewUIntObj(objPtr, uw) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - Tcl_WideUInt uw_ = (uw); \ - if (uw_ > WIDE_MAX) { \ - mp_int bignumValue_; \ - if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + Tcl_WideUInt uw_ = (uw); \ + if (uw_ > WIDE_MAX) { \ + mp_int bignumValue_; \ + if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \ Tcl_Panic("%s: memory overflow", "TclNewUIntObj"); \ - } \ - TclSetBignumInternalRep((objPtr), &bignumValue_); \ - } else { \ + } \ + TclSetBignumInternalRep((objPtr), &bignumValue_); \ + } else { \ (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \ - (objPtr)->typePtr = &tclIntType; \ - } \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + (objPtr)->typePtr = &tclIntType; \ + } \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewIndexObj(objPtr, w) \ TclNewIntObj(objPtr, w) #define TclNewDoubleObj(objPtr, d) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.doubleValue = (double)(d); \ - (objPtr)->typePtr = &tclDoubleType; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.doubleValue = (double)(d); \ + (objPtr)->typePtr = &tclDoubleType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewStringObj(objPtr, s, len) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - TclInitStringRep((objPtr), (s), (len)); \ - (objPtr)->typePtr = NULL; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + TclInitStringRep((objPtr), (s), (len)); \ + (objPtr)->typePtr = NULL; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #else /* TCL_MEM_DEBUG */ @@ -4774,18 +4806,18 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; (objPtr) = Tcl_NewWideIntObj(w) #define TclNewUIntObj(objPtr, uw) \ - do { \ - Tcl_WideUInt uw_ = (uw); \ - if (uw_ > WIDE_MAX) { \ - mp_int bignumValue_; \ - if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) { \ - (objPtr) = Tcl_NewBignumObj(&bignumValue_); \ - } else { \ - (objPtr) = NULL; \ - } \ - } else { \ - (objPtr) = Tcl_NewWideIntObj(uw_); \ - } \ + do { \ + Tcl_WideUInt uw_ = (uw); \ + if (uw_ > WIDE_MAX) { \ + mp_int bignumValue_; \ + if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) { \ + (objPtr) = Tcl_NewBignumObj(&bignumValue_); \ + } else { \ + (objPtr) = NULL; \ + } \ + } else { \ + (objPtr) = Tcl_NewWideIntObj(uw_); \ + } \ } while (0) #define TclNewIndexObj(objPtr, w) \ @@ -4837,28 +4869,26 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; * the internal stubs, but the core can use the macro instead. */ -#define TclCleanupCommandMacro(cmdPtr) \ +#define TclCleanupCommandMacro(cmdPtr) \ do { \ if ((cmdPtr)->refCount-- <= 1) { \ Tcl_Free(cmdPtr); \ } \ } while (0) - /* * inside this routine crement refCount first incase cmdPtr is replacing itself */ -#define TclRoutineAssign(location, cmdPtr) \ - do { \ - (cmdPtr)->refCount++; \ - if ((location) != NULL \ - && (location--) <= 1) { \ - Tcl_Free(((location))); \ - } \ - (location) = (cmdPtr); \ +#define TclRoutineAssign(location, cmdPtr) \ + do { \ + (cmdPtr)->refCount++; \ + if ((location) != NULL \ + && (location--) <= 1) { \ + Tcl_Free(((location))); \ + } \ + (location) = (cmdPtr); \ } while (0) - #define TclRoutineHasName(cmdPtr) \ ((cmdPtr)->hPtr != NULL) @@ -4871,9 +4901,10 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; * to the non-inline version. */ -#define TclLimitExceeded(limit) ((limit).exceeded != 0) +#define TclLimitExceeded(limit) \ + ((limit).exceeded != 0) -#define TclLimitReady(limit) \ +#define TclLimitReady(limit) \ (((limit).active == 0) ? 0 : \ (++(limit).granularityTicker, \ ((((limit).active & TCL_LIMIT_COMMANDS) && \ @@ -4991,7 +5022,8 @@ typedef struct NRE_callback { struct NRE_callback *nextPtr; } NRE_callback; -#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr) +#define TOP_CB(iPtr) \ + (((Interp *)(iPtr))->execEnvPtr->callbackPtr) /* * Inline version of Tcl_NRAddCallback. @@ -5030,9 +5062,9 @@ typedef struct NRE_callback { #include "tclIntPlatDecls.h" #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) -#define Tcl_AttemptAlloc TclpAlloc -#define Tcl_AttemptRealloc TclpRealloc -#define Tcl_Free TclpFree +#define Tcl_AttemptAlloc TclpAlloc +#define Tcl_AttemptRealloc TclpRealloc +#define Tcl_Free TclpFree #endif /* -- cgit v0.12 From f1a4837a8298c3dc593cef50082781de015df329 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 10 May 2024 13:45:45 +0000 Subject: Code style fixes Mostly whitespace fixing really --- generic/tclAlloc.c | 31 +- generic/tclBasic.c | 1396 ++++++++++++++++++++++++++-------------------------- 2 files changed, 724 insertions(+), 703 deletions(-) diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index 3c4fac3..b52d1b3 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -47,17 +47,18 @@ typedef size_t caddr_t; */ union overhead { - union overhead *next; /* when free */ - unsigned char padding[TCL_ALLOCALIGN]; /* align struct to TCL_ALLOCALIGN bytes */ + union overhead *next; /* when free */ + unsigned char padding[TCL_ALLOCALIGN]; + /* align struct to TCL_ALLOCALIGN bytes */ struct { - unsigned char magic0; /* magic number */ - unsigned char index; /* bucket # */ - unsigned char unused; /* unused */ - unsigned char magic1; /* other magic number */ + unsigned char magic0; /* magic number */ + unsigned char index; /* bucket # */ + unsigned char unused; /* unused */ + unsigned char magic1; /* other magic number */ #ifndef NDEBUG - unsigned short rmagic; /* range magic number */ + unsigned short rmagic; /* range magic number */ size_t size; /* actual block size */ - unsigned short unused2; /* padding to 8-byte align */ + unsigned short unused2; /* padding to 8-byte align */ #endif } ovu; #define overMagic0 ovu.magic0 @@ -67,7 +68,6 @@ union overhead { #define realBlockSize ovu.size }; - #define MAGIC 0xEF /* magic # on accounting info */ #define RMAGIC 0x5555 /* magic # on range info */ @@ -92,7 +92,8 @@ union overhead { * precedes the data area returned to the user. */ -#define MINBLOCK ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) +#define MINBLOCK \ + ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) #define NBUCKETS (13 - (MINBLOCK >> 4)) #define MAXMALLOC ((size_t)1 << (NBUCKETS+2)) static union overhead *nextf[NBUCKETS]; @@ -251,7 +252,7 @@ TclFinalizeAllocSubsystem(void) void * TclpAlloc( - size_t numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { union overhead *overPtr; size_t bucket; @@ -385,10 +386,10 @@ TclpAlloc( static void MoreCore( - size_t bucket) /* What bucket to allocate to. */ + size_t bucket) /* What bucket to allocate to. */ { union overhead *overPtr; - size_t size; /* size of desired block */ + size_t size; /* size of desired block */ size_t amount; /* amount to allocate */ size_t numBlocks; /* how many blocks we get */ struct block *blockPtr; @@ -511,7 +512,7 @@ TclpFree( void * TclpRealloc( void *oldPtr, /* Pointer to alloc'ed block. */ - size_t numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { int i; union overhead *overPtr; @@ -743,7 +744,7 @@ TclpFree( void * TclpRealloc( void *oldPtr, /* Pointer to alloced block. */ - size_t numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { return realloc(oldPtr, numBytes); } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 3faa201..ed1ad58 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -63,7 +63,6 @@ /* actually there is no fallback to builtin fpclassify */ #endif /* !TCL_FPCLASSIFY_MODE */ - /* * Bug 7371b6270b: to check C call stack depth, prefer an approach which is * compatible with AddressSanitizer (ASan) use-after-return detection. @@ -85,17 +84,17 @@ void * TclGetCStackPtr(void) { #if defined( __GNUC__ ) || __has_builtin(__builtin_frame_address) - return __builtin_frame_address(0); + return __builtin_frame_address(0); #elif defined(_MSC_VER) && defined(HAVE_INTRIN_H) - return _AddressOfReturnAddress(); + return _AddressOfReturnAddress(); #else - ptrdiff_t unused = 0; - /* - * LLVM recommends using volatile: - * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31 - */ - ptrdiff_t *volatile stackLevel = &unused; - return (void *)stackLevel; + ptrdiff_t unused = 0; + /* + * LLVM recommends using volatile: + * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31 + */ + ptrdiff_t *volatile stackLevel = &unused; + return (void *)stackLevel; #endif } @@ -168,7 +167,7 @@ TCL_DECLARE_MUTEX(commandTypeLock); * Static functions in this file: */ -static Tcl_ObjCmdProc BadEnsembleSubcommand; +static Tcl_ObjCmdProc BadEnsembleSubcommand; static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr, const char *oldName, const char *newName, int flags); @@ -193,12 +192,12 @@ static Tcl_ObjCmdProc ExprDoubleFunc; static Tcl_ObjCmdProc ExprFloorFunc; static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; -static Tcl_ObjCmdProc ExprIsFiniteFunc; -static Tcl_ObjCmdProc ExprIsInfinityFunc; -static Tcl_ObjCmdProc ExprIsNaNFunc; -static Tcl_ObjCmdProc ExprIsNormalFunc; -static Tcl_ObjCmdProc ExprIsSubnormalFunc; -static Tcl_ObjCmdProc ExprIsUnorderedFunc; +static Tcl_ObjCmdProc ExprIsFiniteFunc; +static Tcl_ObjCmdProc ExprIsInfinityFunc; +static Tcl_ObjCmdProc ExprIsNaNFunc; +static Tcl_ObjCmdProc ExprIsNormalFunc; +static Tcl_ObjCmdProc ExprIsSubnormalFunc; +static Tcl_ObjCmdProc ExprIsUnorderedFunc; static Tcl_ObjCmdProc ExprMaxFunc; static Tcl_ObjCmdProc ExprMinFunc; static Tcl_ObjCmdProc ExprRandFunc; @@ -207,7 +206,7 @@ static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; -static Tcl_ObjCmdProc FloatClassifyObjCmd; +static Tcl_ObjCmdProc FloatClassifyObjCmd; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; @@ -253,11 +252,11 @@ MODULE_SCOPE const TclStubs tclStubs; * after particular kinds of [yield]. */ -#define CORO_ACTIVATE_YIELD NULL -#define CORO_ACTIVATE_YIELDM INT2PTR(1) +#define CORO_ACTIVATE_YIELD NULL +#define CORO_ACTIVATE_YIELDM INT2PTR(1) -#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) -#define COROUTINE_ARGUMENTS_ARBITRARY (-2) +#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) +#define COROUTINE_ARGUMENTS_ARBITRARY (-2) /* * The following structure define the commands in the Tcl core. @@ -271,9 +270,9 @@ typedef struct { int flags; /* Various flag bits, as defined below. */ } CmdInfo; -#define CMD_IS_SAFE 1 /* Whether this command is part of the set of - * commands present by default in a safe - * interpreter. */ +#define CMD_IS_SAFE 1 /* Whether this command is part of the set of + * commands present by default in a safe + * interpreter. */ /* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle * expansion for itself rather than needing the generic layer to take care of * it for it. Defined in tclInt.h. */ @@ -287,13 +286,13 @@ typedef struct { */ typedef struct { - const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for - * the end of the list of commands to hide. */ - const char *commandName; /* The name of the command within the - * ensemble. If this is NULL, we want to also - * make the overall command be hidden, an ugly - * hack because it is expected by security - * policies in the wild. */ + const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for + * the end of the list of commands to hide. */ + const char *commandName; /* The name of the command within the + * ensemble. If this is NULL, we want to also + * make the overall command be hidden, an ugly + * hack because it is expected by security + * policies in the wild. */ } UnsafeEnsembleInfo; /* @@ -322,8 +321,8 @@ static const CmdInfo builtInCmds[] = { {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"const", Tcl_ConstObjCmd, TclCompileConstCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, - {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, - {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, + {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, + {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE}, {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE}, @@ -331,7 +330,7 @@ static const CmdInfo builtInCmds[] = { {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, - {"fpclassify", FloatClassifyObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"fpclassify", FloatClassifyObjCmd, NULL, NULL, CMD_IS_SAFE}, {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, @@ -346,12 +345,12 @@ static const CmdInfo builtInCmds[] = { {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, {"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, - {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, - {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, {"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE}, @@ -479,48 +478,52 @@ static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = { * Math functions. All are safe. */ +typedef double (BuiltinUnaryFunc)(double x); +typedef double (BuiltinBinaryFunc)(double x, double y); +#define BINARY_TYPECAST(fn) \ + (BuiltinUnaryFunc *)(void *)(BuiltinBinaryFunc *) fn typedef struct { const char *name; /* Name of the function. The full name is * "::tcl::mathfunc::". */ Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */ - double (*fn)(double x); /* Real function pointer */ + BuiltinUnaryFunc *fn; /* Real function pointer */ } BuiltinFuncDef; static const BuiltinFuncDef BuiltinFuncTable[] = { { "abs", ExprAbsFunc, NULL }, { "acos", ExprUnaryFunc, acos }, { "asin", ExprUnaryFunc, asin }, { "atan", ExprUnaryFunc, atan }, - { "atan2", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) atan2}, + { "atan2", ExprBinaryFunc, BINARY_TYPECAST(atan2) }, { "bool", ExprBoolFunc, NULL }, { "ceil", ExprCeilFunc, NULL }, - { "cos", ExprUnaryFunc, cos }, + { "cos", ExprUnaryFunc, cos }, { "cosh", ExprUnaryFunc, cosh }, { "double", ExprDoubleFunc, NULL }, { "entier", ExprIntFunc, NULL }, - { "exp", ExprUnaryFunc, exp }, + { "exp", ExprUnaryFunc, exp }, { "floor", ExprFloorFunc, NULL }, - { "fmod", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) fmod}, - { "hypot", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) hypot}, + { "fmod", ExprBinaryFunc, BINARY_TYPECAST(fmod) }, + { "hypot", ExprBinaryFunc, BINARY_TYPECAST(hypot) }, { "int", ExprIntFunc, NULL }, - { "isfinite", ExprIsFiniteFunc, NULL }, - { "isinf", ExprIsInfinityFunc, NULL }, - { "isnan", ExprIsNaNFunc, NULL }, - { "isnormal", ExprIsNormalFunc, NULL }, + { "isfinite", ExprIsFiniteFunc, NULL }, + { "isinf", ExprIsInfinityFunc, NULL }, + { "isnan", ExprIsNaNFunc, NULL }, + { "isnormal", ExprIsNormalFunc, NULL }, { "isqrt", ExprIsqrtFunc, NULL }, - { "issubnormal", ExprIsSubnormalFunc, NULL, }, - { "isunordered", ExprIsUnorderedFunc, NULL, }, - { "log", ExprUnaryFunc, log }, + { "issubnormal", ExprIsSubnormalFunc, NULL, }, + { "isunordered", ExprIsUnorderedFunc, NULL, }, + { "log", ExprUnaryFunc, log }, { "log10", ExprUnaryFunc, log10 }, { "max", ExprMaxFunc, NULL }, { "min", ExprMinFunc, NULL }, - { "pow", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) pow}, + { "pow", ExprBinaryFunc, BINARY_TYPECAST(pow) }, { "rand", ExprRandFunc, NULL }, { "round", ExprRoundFunc, NULL }, - { "sin", ExprUnaryFunc, sin }, + { "sin", ExprUnaryFunc, sin }, { "sinh", ExprUnaryFunc, sinh }, { "sqrt", ExprSqrtFunc, NULL }, { "srand", ExprSrandFunc, NULL }, - { "tan", ExprUnaryFunc, tan }, + { "tan", ExprUnaryFunc, tan }, { "tanh", ExprUnaryFunc, tanh }, { "wide", ExprWideFunc, NULL }, { NULL, NULL, NULL } @@ -628,8 +631,8 @@ TclFinalizeEvaluation(void) Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_DeleteHashTable(&commandTypeTable); - commandTypeInit = 0; + Tcl_DeleteHashTable(&commandTypeTable); + commandTypeInit = 0; } Tcl_MutexUnlock(&commandTypeLock); } @@ -668,8 +671,8 @@ buildInfoObjCmd2( char buf[80]; const char *p = strchr((char *)clientData, '.'); if (p) { - const char *q = strchr(p+1, '.'); - const char *r = strchr(p+1, '+'); + const char *q = strchr(p + 1, '.'); + const char *r = strchr(p + 1, '+'); p = (q < r) ? q : r; } if (p) { @@ -692,42 +695,45 @@ buildInfoObjCmd2( if (p) { if ((q = strchr(p, '.'))) { char buf[80]; - memcpy(buf, p+1, q - p - 1); + memcpy(buf, p + 1, q - p - 1); buf[q - p - 1] = '\0'; Tcl_AppendResult(interp, buf, (char *)NULL); } else { - Tcl_AppendResult(interp, p+1, (char *)NULL); + Tcl_AppendResult(interp, p + 1, (char *)NULL); } } return TCL_OK; } else if (len == 8 && !strcmp(arg, "compiler")) { const char *p = strchr((char *)clientData, '.'); while (p) { - if (!strncmp(p+1, "clang-", 6) || !strncmp(p+1, "gcc-", 4) - || !strncmp(p+1, "icc-", 4) || !strncmp(p+1, "msvc-", 5)) { - const char *q = strchr(p+1, '.'); + if (!strncmp(p + 1, "clang-", 6) + || !strncmp(p + 1, "gcc-", 4) + || !strncmp(p + 1, "icc-", 4) + || !strncmp(p + 1, "msvc-", 5)) { + const char *q = strchr(p + 1, '.'); if (q) { char buf[16]; - memcpy(buf, p+1, q - p - 1); + memcpy(buf, p + 1, q - p - 1); buf[q - p - 1] = '\0'; Tcl_AppendResult(interp, buf, (char *)NULL); } else { - Tcl_AppendResult(interp, p+1, (char *)NULL); + Tcl_AppendResult(interp, p + 1, (char *)NULL); } return TCL_OK; } - p = strchr(p+1, '.'); + p = strchr(p + 1, '.'); } Tcl_AppendResult(interp, "0", (char *)NULL); return TCL_OK; } const char *p = strchr((char *)clientData, '.'); while (p) { - if (!strncmp(p+1, arg, len) && ((p[len+1] == '.') || (p[len+1] == '\0'))) { + if (!strncmp(p + 1, arg, len) + && ((p[len + 1] == '.') || (p[len + 1] == '\0'))) { Tcl_AppendResult(interp, "1", (char *)NULL); return TCL_OK; } - p = strchr(p+1, '.'); + p = strchr(p + 1, '.'); } Tcl_AppendResult(interp, "0", (char *)NULL); return TCL_OK; @@ -819,16 +825,16 @@ Tcl_CreateInterp(void) #undef TclObjInterpProc if (commandTypeInit == 0) { - TclRegisterCommandTypeName(TclObjInterpProc, "proc"); - TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); - TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclChildObjCmd, "interp"); - TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); - TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); - TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); - TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); - TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); + TclRegisterCommandTypeName(TclObjInterpProc, "proc"); + TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); + TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclChildObjCmd, "interp"); + TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); + TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); + TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); + TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); + TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); } /* @@ -941,7 +947,7 @@ Tcl_CreateInterp(void) iPtr->flags |= INTERP_DEBUG_FRAME; #else if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) { - iPtr->flags |= INTERP_DEBUG_FRAME; + iPtr->flags |= INTERP_DEBUG_FRAME; } #endif @@ -967,7 +973,7 @@ Tcl_CreateInterp(void) */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ - framePtr = (CallFrame *)Tcl_Alloc(sizeof(CallFrame)); + framePtr = (CallFrame *) Tcl_Alloc(sizeof(CallFrame)); (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0); framePtr->objc = 0; @@ -997,7 +1003,7 @@ Tcl_CreateInterp(void) TclNewObj(iPtr->asyncCancelMsg); - cancelInfo = (CancelInfo *)Tcl_Alloc(sizeof(CancelInfo)); + cancelInfo = (CancelInfo *) Tcl_Alloc(sizeof(CancelInfo)); cancelInfo->interp = interp; iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo); @@ -1061,7 +1067,7 @@ Tcl_CreateInterp(void) */ #if TCL_THREADS && defined(USE_THREAD_ALLOC) - iPtr->allocCache = (AllocCache *)TclpGetAllocCache(); + iPtr->allocCache = (AllocCache *) TclpGetAllocCache(); #else iPtr->allocCache = NULL; #endif @@ -1085,7 +1091,7 @@ Tcl_CreateInterp(void) hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, cmdInfoPtr->name, &isNew); if (isNew) { - cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *) Tcl_Alloc(sizeof(Command)); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; cmdPtr->refCount = 1; @@ -1098,9 +1104,9 @@ Tcl_CreateInterp(void) cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; - if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { - cmdPtr->flags |= CMD_COMPILES_EXPANDED; - } + if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { + cmdPtr->flags |= CMD_COMPILES_EXPANDED; + } cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = cmdInfoPtr->nreProc; @@ -1160,15 +1166,15 @@ Tcl_CreateInterp(void) /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, - "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, - TclNRAssembleObjCmd, NULL, NULL); + "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, + TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRInjectObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype", - CoroTypeObjCmd, NULL, NULL); + CoroTypeObjCmd, NULL, NULL); /* Export unsupported commands */ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); @@ -1176,7 +1182,6 @@ Tcl_CreateInterp(void) Tcl_Export(interp, nsPtr, "*", 1); } - #ifdef USE_DTRACE /* * Register the tcl::dtrace command. @@ -1197,7 +1202,7 @@ Tcl_CreateInterp(void) memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN); for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL; builtinFuncPtr++) { - strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); + strcpy(mathFuncName + MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, builtinFuncPtr->objCmdProc, (void *)builtinFuncPtr->fn, NULL); Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0); @@ -1215,7 +1220,8 @@ Tcl_CreateInterp(void) #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ - TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)Tcl_Alloc(sizeof(TclOpCmdClientData)); + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) + Tcl_Alloc(sizeof(TclOpCmdClientData)); occdPtr->op = opcmdInfoPtr->name; occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; @@ -1321,7 +1327,7 @@ static void DeleteOpCmdClientData( void *clientData) { - TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) clientData; Tcl_Free(occdPtr); } @@ -1331,10 +1337,10 @@ DeleteOpCmdClientData( * * TclRegisterCommandTypeName, TclGetCommandTypeName -- * - * Command type registration and lookup mechanism. Everything is keyed by - * the Tcl_ObjCmdProc for the command, and that is used as the *key* into - * the hash table that maps to constant strings that are names. (It is - * recommended that those names be ASCII.) + * Command type registration and lookup mechanism. Everything is keyed by + * the Tcl_ObjCmdProc for the command, and that is used as the *key* into + * the hash table that maps to constant strings that are names. (It is + * recommended that those names be ASCII.) * * --------------------------------------------------------------------- */ @@ -1348,21 +1354,21 @@ TclRegisterCommandTypeName( Tcl_MutexLock(&commandTypeLock); if (commandTypeInit == 0) { - Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); - commandTypeInit = 1; + Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); + commandTypeInit = 1; } if (nameStr != NULL) { - int isNew; + int isNew; - hPtr = Tcl_CreateHashEntry(&commandTypeTable, - implementationProc, &isNew); - Tcl_SetHashValue(hPtr, (void *) nameStr); + hPtr = Tcl_CreateHashEntry(&commandTypeTable, + implementationProc, &isNew); + Tcl_SetHashValue(hPtr, (void *) nameStr); } else { - hPtr = Tcl_FindHashEntry(&commandTypeTable, - implementationProc); - if (hPtr != NULL) { - Tcl_DeleteHashEntry(hPtr); - } + hPtr = Tcl_FindHashEntry(&commandTypeTable, + implementationProc); + if (hPtr != NULL) { + Tcl_DeleteHashEntry(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); } @@ -1376,15 +1382,15 @@ TclGetCommandTypeName( const char *name = "native"; if (procPtr == NULL) { - procPtr = cmdPtr->nreProc; + procPtr = cmdPtr->nreProc; } Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); - if (hPtr && Tcl_GetHashValue(hPtr)) { - name = (const char *) Tcl_GetHashValue(hPtr); - } + if (hPtr && Tcl_GetHashValue(hPtr)) { + name = (const char *) Tcl_GetHashValue(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); @@ -1424,41 +1430,43 @@ TclHideUnsafeCommands( } for (unsafePtr = unsafeEnsembleCommands; - unsafePtr->ensembleNsName; unsafePtr++) { - if (unsafePtr->commandName) { - /* - * Hide an ensemble subcommand. - */ - - Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - - if (TclRenameCommand(interp, TclGetString(cmdName), - "___tmp") != TCL_OK - || Tcl_HideCommand(interp, "___tmp", - TclGetString(hideName)) != TCL_OK) { - Tcl_Panic("problem making '%s %s' safe: %s", - unsafePtr->ensembleNsName, unsafePtr->commandName, - Tcl_GetStringResult(interp)); - } - Tcl_CreateObjCommand(interp, TclGetString(cmdName), - BadEnsembleSubcommand, (void *)unsafePtr, NULL); - TclDecrRefCount(cmdName); - TclDecrRefCount(hideName); - } else { - /* - * Hide an ensemble main command (for compatibility). - */ - - if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, - unsafePtr->ensembleNsName) != TCL_OK) { - Tcl_Panic("problem making '%s' safe: %s", - unsafePtr->ensembleNsName, - Tcl_GetStringResult(interp)); - } - } + unsafePtr->ensembleNsName; unsafePtr++) { + if (unsafePtr->commandName) { + /* + * Hide an ensemble subcommand. + */ + + Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + +#define INTERIM_HACK_NAME "___tmp" + + if (TclRenameCommand(interp, TclGetString(cmdName), + INTERIM_HACK_NAME) != TCL_OK + || Tcl_HideCommand(interp, INTERIM_HACK_NAME, + TclGetString(hideName)) != TCL_OK) { + Tcl_Panic("problem making '%s %s' safe: %s", + unsafePtr->ensembleNsName, unsafePtr->commandName, + Tcl_GetStringResult(interp)); + } + Tcl_CreateObjCommand(interp, TclGetString(cmdName), + BadEnsembleSubcommand, (void *)unsafePtr, NULL); + TclDecrRefCount(cmdName); + TclDecrRefCount(hideName); + } else { + /* + * Hide an ensemble main command (for compatibility). + */ + + if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, + unsafePtr->ensembleNsName) != TCL_OK) { + Tcl_Panic("problem making '%s' safe: %s", + unsafePtr->ensembleNsName, + Tcl_GetStringResult(interp)); + } + } } return TCL_OK; @@ -1492,8 +1500,8 @@ BadEnsembleSubcommand( const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData; Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "not allowed to invoke subcommand %s of %s", - infoPtr->commandName, infoPtr->ensembleNsName)); + "not allowed to invoke subcommand %s of %s", + infoPtr->commandName, infoPtr->ensembleNsName)); Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL); return TCL_ERROR; } @@ -1524,22 +1532,22 @@ Tcl_CallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; - int *assocDataCounterPtr = - (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); + int *assocDataCounterPtr = (int *) + Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; - AssocData *dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); + AssocData *dPtr = (AssocData *) Tcl_Alloc(sizeof(AssocData)); Tcl_HashEntry *hPtr; snprintf(buffer, sizeof(buffer), "Assoc Data Key #%d", *assocDataCounterPtr); (*assocDataCounterPtr)++; if (iPtr->assocData == NULL) { - iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->assocData = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew); @@ -1572,7 +1580,7 @@ Tcl_DontCallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTablePtr; @@ -1586,7 +1594,7 @@ Tcl_DontCallWhenDeleted( } for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - dPtr = (AssocData *)Tcl_GetHashValue(hPtr); + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) { Tcl_Free(dPtr); Tcl_DeleteHashEntry(hPtr); @@ -1620,7 +1628,7 @@ Tcl_SetAssocData( const char *name, /* Name for association. */ Tcl_InterpDeleteProc *proc, /* Proc to call when interpreter is about to * be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; AssocData *dPtr; @@ -1628,14 +1636,14 @@ Tcl_SetAssocData( int isNew; if (iPtr->assocData == NULL) { - iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->assocData = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew); if (isNew == 0) { - dPtr = (AssocData *)Tcl_GetHashValue(hPtr); + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); } else { - dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); + dPtr = (AssocData *) Tcl_Alloc(sizeof(AssocData)); } dPtr->proc = proc; dPtr->clientData = clientData; @@ -1676,7 +1684,7 @@ Tcl_DeleteAssocData( if (hPtr == NULL) { return; } - dPtr = (AssocData *)Tcl_GetHashValue(hPtr); + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); @@ -1721,7 +1729,7 @@ Tcl_GetAssocData( if (hPtr == NULL) { return NULL; } - dPtr = (AssocData *)Tcl_GetHashValue(hPtr); + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); if (procPtr != NULL) { *procPtr = dPtr->proc; } @@ -1873,7 +1881,7 @@ DeleteInterpProc( Tcl_MutexLock(&cancelLock); hPtr = Tcl_FindHashEntry(&cancelTable, iPtr); if (hPtr != NULL) { - CancelInfo *cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); + CancelInfo *cancelInfo = (CancelInfo *) Tcl_GetHashValue(hPtr); if (cancelInfo != NULL) { if (cancelInfo->result != NULL) { @@ -1931,13 +1939,13 @@ DeleteInterpProc( hPtr = Tcl_FirstHashEntry(hTablePtr, &search); for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr)); + Tcl_DeleteCommandFromToken(interp, + (Tcl_Command) Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(hTablePtr); Tcl_Free(hTablePtr); } - if (iPtr->assocData != NULL) { AssocData *dPtr; @@ -1949,7 +1957,7 @@ DeleteInterpProc( for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search); hPtr != NULL; hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) { - dPtr = (AssocData *)Tcl_GetHashValue(hPtr); + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } @@ -2037,7 +2045,7 @@ DeleteInterpProc( for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - CmdFrame *cfPtr = (CmdFrame *)Tcl_GetHashValue(hPtr); + CmdFrame *cfPtr = (CmdFrame *) Tcl_GetHashValue(hPtr); Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); procPtr->iPtr = NULL; @@ -2061,7 +2069,7 @@ DeleteInterpProc( for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ExtCmdLoc *eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hPtr); + ExtCmdLoc *eclPtr = (ExtCmdLoc *) Tcl_GetHashValue(hPtr); if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); @@ -2190,7 +2198,7 @@ Tcl_HideCommand( Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" " token (rename)", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); return TCL_ERROR; } @@ -2213,9 +2221,9 @@ Tcl_HideCommand( if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only hide global namespace commands (use rename then hide)", - -1)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); + "can only hide global namespace commands (use rename then hide)", + -1)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } @@ -2225,7 +2233,7 @@ Tcl_HideCommand( hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; if (hiddenCmdTablePtr == NULL) { - hiddenCmdTablePtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + hiddenCmdTablePtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS); iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr; } @@ -2239,9 +2247,9 @@ Tcl_HideCommand( hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "hidden command named \"%s\" already exists", - hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); + "hidden command named \"%s\" already exists", + hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); return TCL_ERROR; } @@ -2343,9 +2351,9 @@ Tcl_ExposeCommand( if (strstr(cmdName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot expose to a namespace (use expose to toplevel, then rename)", - -1)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); + "cannot expose to a namespace (use expose to toplevel, then rename)", + -1)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } @@ -2360,12 +2368,12 @@ Tcl_ExposeCommand( } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown hidden command \"%s\"", hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", - hiddenCmdToken, (char *)NULL); + "unknown hidden command \"%s\"", hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", + hiddenCmdToken, (char *)NULL); return TCL_ERROR; } - cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); /* * Check that we have a true global namespace command (enforced by @@ -2399,8 +2407,8 @@ Tcl_ExposeCommand( hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "exposed command \"%s\" already exists", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); + "exposed command \"%s\" already exists", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); return TCL_ERROR; } @@ -2497,7 +2505,7 @@ Tcl_CreateCommand( * specified namespace; otherwise it is put in * the global namespace. */ Tcl_CmdProc *proc, /* Function to associate with cmdName. */ - void *clientData, /* Arbitrary value passed to string proc. */ + void *clientData, /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ @@ -2528,26 +2536,26 @@ Tcl_CreateCommand( */ while (1) { - /* - * Determine where the command should reside. If its name contains - * namespace qualifiers, we put it in the specified namespace; + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; * otherwise, we always put it in the global namespace. - */ + */ - if (strstr(cmdName, "::") != NULL) { + if (strstr(cmdName, "::") != NULL) { Namespace *dummy1, *dummy2; TclGetNamespaceForQualName(interp, cmdName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if ((nsPtr == NULL) || (tail == NULL)) { - return (Tcl_Command) NULL; + return (Tcl_Command) NULL; } - } else { + } else { nsPtr = iPtr->globalNsPtr; tail = cmdName; - } + } - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); if (isNew || deleted) { /* @@ -2558,10 +2566,10 @@ Tcl_CreateCommand( } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ - cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); /* * Be careful to preserve any existing import links so we can restore @@ -2616,7 +2624,7 @@ Tcl_CreateCommand( TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *) Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; @@ -2643,7 +2651,7 @@ Tcl_CreateCommand( cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; - dataPtr = (ImportedCmdData *)refCmdPtr->objClientData; + dataPtr = (ImportedCmdData *) refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; } @@ -2692,7 +2700,6 @@ typedef struct { Tcl_ObjCmdProc2 *nreProc; } CmdWrapperInfo; - static int cmdWrapperProc( void *clientData, @@ -2700,7 +2707,7 @@ cmdWrapperProc( int objc, Tcl_Obj * const *objv) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; if (objc < 0) { objc = -1; } @@ -2711,7 +2718,7 @@ static void cmdWrapperDeleteProc( void *clientData) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; clientData = info->deleteData; Tcl_CmdDeleteProc *deleteProc = info->deleteProc; @@ -2731,14 +2738,14 @@ Tcl_CreateObjCommand2( * the global namespace. */ Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc /* If not NULL, gives a function to call when * this command is deleted. */ ) { - CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *) Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = proc; info->clientData = clientData; info->deleteProc = deleteProc; @@ -2759,7 +2766,7 @@ Tcl_CreateObjCommand( * the global namespace. */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc /* If not NULL, gives a function to call when @@ -2805,11 +2812,11 @@ Tcl_Command TclCreateObjCommandInNs( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace - * components. */ - Tcl_Namespace *namesp, /* The namespace to create the command in */ + * components. */ + Tcl_Namespace *namesp, /* The namespace to create the command in */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when @@ -2841,10 +2848,10 @@ TclCreateObjCommandInNs( } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ - cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); /* * Command already exists; delete it. Be careful to preserve any @@ -2859,14 +2866,14 @@ TclCreateObjCommandInNs( } /* - * Make sure namespace doesn't get deallocated. - */ + * Make sure namespace doesn't get deallocated. + */ cmdPtr->nsPtr->refCount++; Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); nsPtr = (Namespace *) TclEnsureNamespace(interp, - (Tcl_Namespace *) cmdPtr->nsPtr); + (Tcl_Namespace *) cmdPtr->nsPtr); TclNsDecrRefCount(cmdPtr->nsPtr); if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) { @@ -2908,7 +2915,7 @@ TclCreateObjCommandInNs( TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *) Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; @@ -2936,7 +2943,7 @@ TclCreateObjCommandInNs( while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; - dataPtr = (ImportedCmdData*)refCmdPtr->objClientData; + dataPtr = (ImportedCmdData*) refCmdPtr->objClientData; cmdPtr->refCount++; TclCleanupCommandMacro(dataPtr->realCmdPtr); dataPtr->realCmdPtr = cmdPtr; @@ -2978,12 +2985,12 @@ TclCreateObjCommandInNs( int InvokeStringCommand( - void *clientData, /* Points to command's Command structure. */ + void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Command *cmdPtr = (Command *)clientData; + Command *cmdPtr = (Command *) clientData; int i, result; const char **argv = (const char **) TclStackAlloc(interp, (objc + 1) * sizeof(char *)); @@ -3052,10 +3059,10 @@ TclRenameCommand( cmdPtr = (Command *) cmd; if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't %s \"%s\": command doesn't exist", - ((newName == NULL)||(*newName == '\0'))? "delete":"rename", + "can't %s \"%s\": command doesn't exist", + ((newName == NULL) || (*newName == '\0')) ? "delete" : "rename", oldName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); return TCL_ERROR; } @@ -3085,16 +3092,16 @@ TclRenameCommand( if ((newNsPtr == NULL) || (newTail == NULL)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": bad command name", newName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); + "can't rename to \"%s\": bad command name", newName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); result = TCL_ERROR; goto done; } if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": command already exists", newName)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", - "TARGET_EXISTS", (char *)NULL); + "can't rename to \"%s\": command already exists", newName)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", + "TARGET_EXISTS", (char *)NULL); result = TCL_ERROR; goto done; } @@ -3266,7 +3273,7 @@ Tcl_SetCommandInfo( static int invokeObj2Command( - void *clientData, /* Points to command's Command structure. */ + void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3293,7 +3300,7 @@ cmdWrapper2Proc( Tcl_Size objc, Tcl_Obj *const objv[]) { - Command *cmdPtr = (Command *)clientData; + Command *cmdPtr = (Command *) clientData; if (objc > INT_MAX) { return TclCommandWordLimitError(interp, objc); } @@ -3330,7 +3337,7 @@ Tcl_SetCommandInfoFromToken( cmdPtr->objClientData = infoPtr->objClientData; } if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { - CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; + CmdWrapperInfo *info = (CmdWrapperInfo *) cmdPtr->deleteData; if (infoPtr->objProc2 == NULL) { info->proc = invokeObj2Command; info->clientData = cmdPtr; @@ -3346,7 +3353,8 @@ Tcl_SetCommandInfoFromToken( info->deleteData = infoPtr->deleteData; } else { if ((infoPtr->objProc2 != NULL) && (infoPtr->objProc2 != cmdWrapper2Proc)) { - CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *) + Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = infoPtr->objProc2; info->clientData = infoPtr->objClientData2; info->nreProc = NULL; @@ -3437,7 +3445,7 @@ Tcl_GetCommandInfoFromToken( infoPtr->proc = cmdPtr->proc; infoPtr->clientData = cmdPtr->clientData; if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { - CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; + CmdWrapperInfo *info = (CmdWrapperInfo *) cmdPtr->deleteData; infoPtr->deleteProc = info->deleteProc; infoPtr->deleteData = info->deleteData; infoPtr->objProc2 = info->proc; @@ -3491,7 +3499,7 @@ Tcl_GetCommandName( return ""; } - return (const char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); + return (const char *) Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); } /* @@ -3541,7 +3549,8 @@ Tcl_GetCommandFullName( } } if (cmdPtr->hPtr != NULL) { - name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); + name = (char *) + Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); Tcl_AppendToObj(objPtr, name, -1); } } @@ -3666,7 +3675,7 @@ Tcl_DeleteCommandFromToken( if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; /* CallCommandTraces() does not cmdPtr, that's - * done just before Tcl_DeleteCommandFromToken() returns */ + * done just before Tcl_DeleteCommandFromToken() returns */ CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); /* @@ -3920,11 +3929,11 @@ CallCommandTraces( static int CancelEvalProc( - void *clientData, /* Interp to cancel the script in progress. */ + void *clientData, /* Interp to cancel the script in progress. */ TCL_UNUSED(Tcl_Interp *), int code) /* Current return code from command. */ { - CancelInfo *cancelInfo = (CancelInfo *)clientData; + CancelInfo *cancelInfo = (CancelInfo *) clientData; Interp *iPtr; if (cancelInfo != NULL) { @@ -3998,7 +4007,7 @@ CancelEvalProc( void TclCleanupCommand( - Command *cmdPtr) /* Points to the Command structure to + Command *cmdPtr) /* Points to the Command structure to * be freed. */ { if (cmdPtr->refCount-- <= 1) { @@ -4150,7 +4159,7 @@ Tcl_Canceled( */ if (!TclCanceled(iPtr)) { - return TCL_OK; + return TCL_OK; } /* @@ -4171,7 +4180,7 @@ Tcl_Canceled( */ if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) { - return TCL_OK; + return TCL_OK; } /* @@ -4180,34 +4189,34 @@ Tcl_Canceled( */ if (flags & TCL_LEAVE_ERR_MSG) { - const char *id, *message = NULL; - Tcl_Size length; + const char *id, *message = NULL; + Tcl_Size length; - /* - * Setup errorCode variables so that we can differentiate between - * being canceled and unwound. - */ + /* + * Setup errorCode variables so that we can differentiate between + * being canceled and unwound. + */ - if (iPtr->asyncCancelMsg != NULL) { - message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); - } else { - length = 0; - } + if (iPtr->asyncCancelMsg != NULL) { + message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); + } else { + length = 0; + } - if (iPtr->flags & TCL_CANCEL_UNWIND) { - id = "IUNWIND"; - if (length == 0) { - message = "eval unwound"; - } - } else { - id = "ICANCEL"; - if (length == 0) { - message = "eval canceled"; - } - } + if (iPtr->flags & TCL_CANCEL_UNWIND) { + id = "IUNWIND"; + if (length == 0) { + message = "eval unwound"; + } + } else { + id = "ICANCEL"; + if (length == 0) { + message = "eval canceled"; + } + } - Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); - Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); + Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); } /* @@ -4246,7 +4255,7 @@ Tcl_CancelEval( * script. */ Tcl_Obj *resultObjPtr, /* The script cancellation error message or * NULL for a default error message. */ - void *clientData, /* Passed to CancelEvalProc. */ + void *clientData, /* Passed to CancelEvalProc. */ int flags) /* Collection of OR-ed bits that control * the cancellation of the script. Only * TCL_CANCEL_UNWIND is currently @@ -4277,7 +4286,7 @@ Tcl_CancelEval( goto done; } - cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); + cancelInfo = (CancelInfo *) Tcl_GetHashValue(hPtr); /* * Populate information needed by the interpreter thread to fulfill the @@ -4289,7 +4298,8 @@ Tcl_CancelEval( if (resultObjPtr != NULL) { result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); - cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result,cancelInfo->length); + cancelInfo->result = (char *) + Tcl_Realloc(cancelInfo->result, cancelInfo->length); memcpy(cancelInfo->result, result, cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { @@ -4392,7 +4402,7 @@ TclNREvalObjv( */ if (iPtr->deferredCallbacks) { - iPtr->deferredCallbacks = NULL; + iPtr->deferredCallbacks = NULL; } else { TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); } @@ -4409,10 +4419,10 @@ EvalObjvCore( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - Command *cmdPtr = NULL, *preCmdPtr = (Command *)data[0]; + Command *cmdPtr = NULL, *preCmdPtr = (Command *) data[0]; int flags = PTR2INT(data[1]); int objc = PTR2INT(data[2]); - Tcl_Obj **objv = (Tcl_Obj **)data[3]; + Tcl_Obj **objv = (Tcl_Obj **) data[3]; Interp *iPtr = (Interp *) interp; Namespace *lookupNsPtr = NULL; int enterTracesDone = 0; @@ -4480,13 +4490,13 @@ EvalObjvCore( assert(cmdPtr == NULL); if (preCmdPtr) { /* - * Caller gave it to us. - */ + * Caller gave it to us. + */ if (!(preCmdPtr->flags & CMD_DEAD)) { /* - * So long as it exists, use it. - */ + * So long as it exists, use it. + */ cmdPtr = preCmdPtr; } else if (flags & TCL_EVAL_NORESOLVE) { @@ -4511,7 +4521,7 @@ EvalObjvCore( if (enterTracesDone || iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { Tcl_Obj *commandPtr = TclGetSourceFromFrame( - flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, + flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, objc, objv); Tcl_IncrRefCount(commandPtr); @@ -4554,7 +4564,7 @@ EvalObjvCore( cmdPtr->refCount++; TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc), - commandPtr, cmdPtr, objv); + commandPtr, cmdPtr, objv); } TclNRAddCallback(interp, Dispatch, @@ -4569,10 +4579,10 @@ Dispatch( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0]; + Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *) data[0]; void *clientData = data[1]; Tcl_Size objc = PTR2INT(data[2]); - Tcl_Obj **objv = (Tcl_Obj **)data[3]; + Tcl_Obj **objv = (Tcl_Obj **) data[3]; Interp *iPtr = (Interp *) interp; #ifdef USE_DTRACE @@ -4617,8 +4627,8 @@ TclNRRunCallbacks( * are to be run. */ { while (TOP_CB(interp) != rootPtr) { - NRE_callback *callbackPtr = TOP_CB(interp); - Tcl_NRPostProc *procPtr = callbackPtr->procPtr; + NRE_callback *callbackPtr = TOP_CB(interp); + Tcl_NRPostProc *procPtr = callbackPtr->procPtr; TOP_CB(interp) = callbackPtr->nextPtr; result = procPtr(callbackPtr->data, interp, result); @@ -4638,12 +4648,12 @@ NRCommand( iPtr->numLevels--; - /* - * If there is a tailcall, schedule it next - */ + /* + * If there is a tailcall, schedule it next + */ if (data[1] && (data[1] != INT2PTR(1))) { - listPtr = (Tcl_Obj *)data[1]; + listPtr = (Tcl_Obj *) data[1]; data[1] = NULL; TclNRAddCallback(interp, TclNRTailcallEval, listPtr, NULL, NULL, NULL); @@ -4737,7 +4747,7 @@ TEOV_RestoreVarFrame( Tcl_Interp *interp, int result) { - ((Interp *) interp)->varFramePtr = (CallFrame *)data[0]; + ((Interp *) interp)->varFramePtr = (CallFrame *) data[0]; return result; } @@ -4781,7 +4791,7 @@ TEOV_Error( const char *cmdString; Tcl_Size cmdLen; int objc = PTR2INT(data[0]); - Tcl_Obj **objv = (Tcl_Obj **)data[1]; + Tcl_Obj **objv = (Tcl_Obj **) data[1]; if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { /* @@ -4843,7 +4853,7 @@ TEOV_NotFound( TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; - newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); + newObjv = (Tcl_Obj **) TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); /* * Copy command prefix from unknown handler and add on the real command's @@ -4855,7 +4865,7 @@ TEOV_NotFound( newObjv[i] = handlerObjv[i]; Tcl_IncrRefCount(newObjv[i]); } - memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc); + memcpy(newObjv + handlerObjc, objv, sizeof(Tcl_Obj *) * objc); /* * Look up and invoke the handler (by recursive call to this function). If @@ -4870,9 +4880,9 @@ TEOV_NotFound( cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr); if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid command name \"%s\"", TclGetString(objv[0]))); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", - TclGetString(objv[0]), (char *)NULL); + "invalid command name \"%s\"", TclGetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", + TclGetString(objv[0]), (char *)NULL); /* * Release any resources we locked and allocated during the handler @@ -4904,8 +4914,8 @@ TEOV_NotFoundCallback( { Interp *iPtr = (Interp *) interp; int objc = PTR2INT(data[0]); - Tcl_Obj **objv = (Tcl_Obj **)data[1]; - Namespace *savedNsPtr = (Namespace *)data[2]; + Tcl_Obj **objv = (Tcl_Obj **) data[1]; + Namespace *savedNsPtr = (Namespace *) data[2]; int i; @@ -4985,9 +4995,9 @@ TEOV_RunLeaveTraces( Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; int objc = PTR2INT(data[0]); - Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; - Command *cmdPtr = (Command *)data[2]; - Tcl_Obj **objv = (Tcl_Obj **)data[3]; + Tcl_Obj *commandPtr = (Tcl_Obj *) data[1]; + Command *cmdPtr = (Command *) data[2]; + Tcl_Obj **objv = (Tcl_Obj **) data[3]; Tcl_Size length; const char *command = TclGetStringFromObj(commandPtr, &length); @@ -5071,7 +5081,7 @@ Tcl_EvalTokensStandard( * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - Tcl_Size count) /* Number of tokens to consider at tokenPtr. + Tcl_Size count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, @@ -5126,7 +5136,7 @@ TclEvalEx( * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ Tcl_Size line, /* The line the script starts on. */ - Tcl_Size *clNextOuter, /* Information about an outer context for */ + Tcl_Size *clNextOuter, /* Information about an outer context for */ const char *outerScript) /* continuation line data. This is set only in * TclSubstTokens(), to properly handle * [...]-nested commands. The 'outerScript' @@ -5162,15 +5172,18 @@ TclEvalEx( * state has been allocated while evaluating * the script, so that it can be freed * properly if an error occurs. */ - Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); - CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); + Tcl_Parse *parsePtr = (Tcl_Parse *) + TclStackAlloc(interp, sizeof(Tcl_Parse)); + CmdFrame *eeFramePtr = (CmdFrame *) + TclStackAlloc(interp, sizeof(CmdFrame)); Tcl_Obj **stackObjArray = (Tcl_Obj **) TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); - int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int)); - Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size)); + int *expandStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int)); + Tcl_Size *linesStack = (Tcl_Size *) + TclStackAlloc(interp, minObjs * sizeof(Tcl_Size)); /* TIP #280 Structures for tracking of command * locations. */ - Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible + Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible * continuation lines. Initialized only if the * caller gave us a table of locations to * track, via scriptCLLocPtr. It always refers @@ -5303,9 +5316,11 @@ TclEvalEx( */ if (numWords > minObjs) { - expand = (int *)Tcl_Alloc(numWords * sizeof(int)); - objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); - lineSpace = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size)); + expand = (int *) Tcl_Alloc(numWords * sizeof(int)); + objvSpace = (Tcl_Obj **) + Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); + lineSpace = (Tcl_Size *) + Tcl_Alloc(numWords * sizeof(Tcl_Size)); } expandRequested = 0; objv = objvSpace; @@ -5314,7 +5329,7 @@ TclEvalEx( iPtr->cmdFramePtr = eeFramePtr->nextPtr; for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr; objectsUsed < numWords; - objectsUsed++, tokenPtr += tokenPtr->numComponents+1) { + objectsUsed++, tokenPtr += tokenPtr->numComponents + 1) { Tcl_Size additionalObjsCount; /* @@ -5337,7 +5352,7 @@ TclEvalEx( iPtr->evalFlags |= TCL_EVAL_FILE; } - code = TclSubstTokens(interp, tokenPtr+1, + code = TclSubstTokens(interp, tokenPtr + 1, tokenPtr->numComponents, NULL, wordLine, wordCLNext, outerScript); @@ -5359,7 +5374,8 @@ TclEvalEx( */ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (expanding word %" TCL_SIZE_MODIFIER "d)", objectsUsed)); + "\n (expanding word %" TCL_SIZE_MODIFIER "d)", + objectsUsed)); Tcl_DecrRefCount(objv[objectsUsed]); break; } @@ -5402,9 +5418,10 @@ TclEvalEx( Tcl_Size objIdx = objectsNeeded - 1; if ((numWords > minObjs) || (objectsNeeded > minObjs)) { - objv = objvSpace = - (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); - lines = lineSpace = (Tcl_Size *)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size)); + objv = objvSpace = (Tcl_Obj **) + Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); + lines = lineSpace = (Tcl_Size *) + Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size)); } objectsUsed = 0; @@ -5428,7 +5445,7 @@ TclEvalEx( objectsUsed++; } } - objv += objIdx+1; + objv += objIdx + 1; if (copy != stackObjArray) { Tcl_Free(copy); @@ -5725,7 +5742,7 @@ TclArgumentEnter( * and initialize references. */ - cfwPtr = (CFWord *)Tcl_Alloc(sizeof(CFWord)); + cfwPtr = (CFWord *) Tcl_Alloc(sizeof(CFWord)); cfwPtr->framePtr = cfPtr; cfwPtr->word = i; cfwPtr->refCount = 1; @@ -5736,7 +5753,7 @@ TclArgumentEnter( * relevant. Just remember the reference to prevent early removal. */ - cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); + cfwPtr = (CFWord *) Tcl_GetHashValue(hPtr); cfwPtr->refCount++; } } @@ -5773,13 +5790,12 @@ TclArgumentRelease( for (i = 1; i < objc; i++) { CFWord *cfwPtr; - Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]); if (!hPtr) { continue; } - cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); + cfwPtr = (CFWord *) Tcl_GetHashValue(hPtr); if (cfwPtr->refCount-- > 1) { continue; @@ -5825,13 +5841,12 @@ TclArgumentBCEnter( ECL *ePtr; CFWordBC *lastPtr = NULL; Interp *iPtr = (Interp *) interp; - Tcl_HashEntry *hePtr = - Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); + Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); if (!hePtr) { return; } - eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr); + eclPtr = (ExtCmdLoc *) Tcl_GetHashValue(hePtr); ePtr = &eclPtr->loc[cmd]; /* @@ -5848,7 +5863,7 @@ TclArgumentBCEnter( */ if (ePtr->nline != objc) { - return; + return; } /* @@ -5866,8 +5881,8 @@ TclArgumentBCEnter( if (ePtr->line[word] >= 0) { int isNew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, - objv[word], &isNew); - CFWordBC *cfwPtr = (CFWordBC *)Tcl_Alloc(sizeof(CFWordBC)); + objv[word], &isNew); + CFWordBC *cfwPtr = (CFWordBC *) Tcl_Alloc(sizeof(CFWordBC)); cfwPtr->framePtr = cfPtr; cfwPtr->obj = objv[word]; @@ -5891,7 +5906,7 @@ TclArgumentBCEnter( * information in the new structure. */ - cfwPtr->prevPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); + cfwPtr->prevPtr = (CFWordBC *) Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, cfwPtr); @@ -5933,7 +5948,7 @@ TclArgumentBCRelease( CFWordBC *nextPtr = cfwPtr->nextPtr; Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, cfwPtr->obj); - CFWordBC *xPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); + CFWordBC *xPtr = (CFWordBC *) Tcl_GetHashValue(hPtr); if (xPtr != cfwPtr) { Tcl_Panic("TclArgumentBC Enter/Release Mismatch"); @@ -5999,7 +6014,7 @@ TclArgumentGet( hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, obj); if (hPtr) { - CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); + CFWord *cfwPtr = (CFWord *) Tcl_GetHashValue(hPtr); *wordPtr = cfwPtr->word; *cfPtrPtr = cfwPtr->framePtr; @@ -6013,7 +6028,7 @@ TclArgumentGet( hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, obj); if (hPtr) { - CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); + CFWordBC *cfwPtr = (CFWordBC *) Tcl_GetHashValue(hPtr); framePtr = cfwPtr->framePtr; framePtr->data.tebc.pc = (char *) (((ByteCode *) @@ -6056,7 +6071,7 @@ 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 + 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 @@ -6069,7 +6084,7 @@ 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 + 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 @@ -6088,7 +6103,7 @@ 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 + 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 @@ -6152,7 +6167,7 @@ TclNREvalObjEx( * should be pushed, as needed by alias and ensemble redirections. */ - eoFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); + eoFramePtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame)); eoFramePtr->nline = 0; eoFramePtr->line = NULL; @@ -6173,7 +6188,7 @@ TclNREvalObjEx( } TclMarkTailcall(interp); - TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, + TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); TclListObjGetElements(NULL, listPtr, &objc, &objv); @@ -6194,9 +6209,9 @@ TclNREvalObjEx( * iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ - if (TclInterpReady(interp) != TCL_OK) { - return TCL_ERROR; - } + if (TclInterpReady(interp) != TCL_OK) { + return TCL_ERROR; + } if (flags & TCL_EVAL_GLOBAL) { savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; @@ -6206,7 +6221,7 @@ TclNREvalObjEx( TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr, objPtr, INT2PTR(allowExceptions), NULL); - return TclNRExecuteByteCode(interp, codePtr); + return TclNRExecuteByteCode(interp, codePtr); } { @@ -6261,8 +6276,8 @@ TEOEx_ByteCodeCallback( int result) { Interp *iPtr = (Interp *) interp; - CallFrame *savedVarFramePtr = (CallFrame *)data[0]; - Tcl_Obj *objPtr = (Tcl_Obj *)data[1]; + CallFrame *savedVarFramePtr = (CallFrame *) data[0]; + Tcl_Obj *objPtr = (Tcl_Obj *) data[1]; int allowExceptions = PTR2INT(data[2]); if (iPtr->numLevels == 0) { @@ -6307,9 +6322,9 @@ TEOEx_ListCallback( int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; - CmdFrame *eoFramePtr = (CmdFrame *)data[1]; - Tcl_Obj *objPtr = (Tcl_Obj *)data[2]; + Tcl_Obj *listPtr = (Tcl_Obj *) data[0]; + CmdFrame *eoFramePtr = (CmdFrame *) data[1]; + Tcl_Obj *objPtr = (Tcl_Obj *) data[2]; /* * Remove the cmdFrame @@ -6489,7 +6504,7 @@ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ long *ptr) /* Where to store long result. */ { Tcl_Obj *resultPtr; @@ -6502,7 +6517,7 @@ Tcl_ExprLongObj( return TCL_ERROR; } - if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) { + if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type) != TCL_OK) { return TCL_ERROR; } @@ -6536,7 +6551,7 @@ int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ double *ptr) /* Where to store double result. */ { Tcl_Obj *resultPtr; @@ -6612,7 +6627,7 @@ int TclObjInvokeNamespace( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ Tcl_Namespace *nsPtr, /* The namespace to use. */ @@ -6656,7 +6671,7 @@ int TclObjInvoke( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ int flags) /* Combination of flags controlling the call: @@ -6668,7 +6683,7 @@ TclObjInvoke( } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal argument vector", -1)); + "illegal argument vector", -1)); return TCL_ERROR; } if ((flags & TCL_INVOKE_HIDDEN) == 0) { @@ -6697,12 +6712,12 @@ TclNRInvoke( } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid hidden command name \"%s\"", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, - (char *)NULL); + "invalid hidden command name \"%s\"", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, + (char *)NULL); return TCL_ERROR; } - cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); /* * Avoid the exception-handling brain damage when numLevels == 0 @@ -6726,7 +6741,7 @@ NRPostInvoke( Tcl_Interp *interp, int result) { - Interp *iPtr = (Interp *)interp; + Interp *iPtr = (Interp *) interp; iPtr->numLevels--; return result; @@ -7187,7 +7202,7 @@ ExprIsqrtFunc( negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "square root of negative argument", -1)); + "square root of negative argument", -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", (char *)NULL); return TCL_ERROR; @@ -7247,7 +7262,7 @@ ExprSqrtFunc( static int ExprUnaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes one double argument and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the @@ -7257,7 +7272,7 @@ ExprUnaryFunc( { int code; double d; - double (*func)(double) = (double (*)(double)) clientData; + BuiltinUnaryFunc *func = (BuiltinUnaryFunc *) clientData; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); @@ -7311,7 +7326,7 @@ CheckDoubleResult( static int ExprBinaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes two double arguments and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the @@ -7321,7 +7336,7 @@ ExprBinaryFunc( { int code; double d1, d2; - double (*func)(double, double) = (double (*)(double, double)) clientData; + BuiltinBinaryFunc *func = (BuiltinBinaryFunc *) clientData; if (objc != 3) { MathFuncWrongNumArgs(interp, 3, objc, objv); @@ -7397,13 +7412,14 @@ ExprAbsFunc( Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); return TCL_OK; } - bytes++; numBytes--; + bytes++; + numBytes--; } } goto unChanged; } else if (l == WIDE_MIN) { if (sizeof(Tcl_WideInt) > sizeof(int64_t)) { - Tcl_WideUInt ul = -(Tcl_WideUInt)WIDE_MIN; + Tcl_WideUInt ul = -(Tcl_WideUInt) WIDE_MIN; if (mp_init(&big) != MP_OKAY || mp_unpack(&big, 1, 1, sizeof(Tcl_WideInt), 0, 0, &ul) != MP_OKAY) { return TCL_ERROR; @@ -7539,7 +7555,7 @@ ExprIntFunc( if (type == TCL_NUMBER_DOUBLE) { d = *((const double *) ptr); - if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) { + if ((d >= (double) WIDE_MAX) || (d <= (double) WIDE_MIN)) { mp_int big; if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { @@ -7615,20 +7631,20 @@ ExprMaxMinFunc( } res = objv[1]; for (i = 1; i < objc; i++) { - if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { - return TCL_ERROR; - } - if (type == TCL_NUMBER_NAN) { - /* - * Get the error message for NaN. - */ - - Tcl_GetDoubleFromObj(interp, objv[i], &d); - return TCL_ERROR; - } - if (TclCompareTwoNumbers(objv[i], res) == op) { - res = objv[i]; - } + if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type == TCL_NUMBER_NAN) { + /* + * Get the error message for NaN. + */ + + Tcl_GetDoubleFromObj(interp, objv[i], &d); + return TCL_ERROR; + } + if (TclCompareTwoNumbers(objv[i], res) == op) { + res = objv[i]; + } } Tcl_SetObjResult(interp, res); @@ -7684,7 +7700,7 @@ ExprRandFunc( * take into consideration the thread this interp is running in. */ - iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread())*4093U; + iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread()) * 4093U; /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. @@ -7781,7 +7797,7 @@ ExprRoundFunc( } else if (fractPart >= 0.5) { max--; } - if ((intPart >= (double)max) || (intPart <= (double)min)) { + if ((intPart >= (double) max) || (intPart <= (double) min)) { mp_int big; mp_err err = MP_OKAY; @@ -7800,7 +7816,7 @@ ExprRoundFunc( Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; } else { - Tcl_WideInt result = (Tcl_WideInt)intPart; + Tcl_WideInt result = (Tcl_WideInt) intPart; if (fractPart <= -0.5) { result--; @@ -7881,8 +7897,8 @@ ExprSrandFunc( * This page contains the functions that implement all of the built-in * math functions for classifying IEEE doubles. * - * These have to be a little bit careful while Tcl_GetDoubleFromObj() - * rejects NaN values, which these functions *explicitly* accept. + * These have to be a little bit careful while Tcl_GetDoubleFromObj() + * rejects NaN values, which these functions *explicitly* accept. * * Results: * Each function returns TCL_OK if it succeeds and pushes an Tcl object @@ -7916,16 +7932,16 @@ ClassifyDouble( * Hence we define those here. */ #ifndef FP_NAN -# define FP_NAN 1 /* Value is NaN */ -# define FP_INFINITE 2 /* Value is an infinity */ -# define FP_ZERO 3 /* Value is a zero */ -# define FP_NORMAL 4 /* Value is a normal float */ -# define FP_SUBNORMAL 5 /* Value has lost accuracy */ +# define FP_NAN 1 /* Value is NaN */ +# define FP_INFINITE 2 /* Value is an infinity */ +# define FP_ZERO 3 /* Value is a zero */ +# define FP_NORMAL 4 /* Value is a normal float */ +# define FP_SUBNORMAL 5 /* Value has lost accuracy */ #endif /* !FP_NAN */ #if TCL_FPCLASSIFY_MODE == 3 return __builtin_fpclassify( - FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); + FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); #elif TCL_FPCLASSIFY_MODE == 2 /* * We assume this hack is only needed on little-endian systems. @@ -7935,27 +7951,27 @@ ClassifyDouble( */ union { - double d; /* Interpret as double */ - struct { - unsigned int low; /* Lower 32 bits */ - unsigned int high; /* Upper 32 bits */ - } w; /* Interpret as unsigned integer words */ - } doubleMeaning; /* So we can look at the representation of a - * double directly. Platform (i.e., processor) - * specific; this is for x86 (and most other - * little-endian processors, but those are - * untested). */ + double d; /* Interpret as double */ + struct { + unsigned int low; /* Lower 32 bits */ + unsigned int high; /* Upper 32 bits */ + } w; /* Interpret as unsigned integer words */ + } doubleMeaning; /* So we can look at the representation of a + * double directly. Platform (i.e., processor) + * specific; this is for x86 (and most other + * little-endian processors, but those are + * untested). */ unsigned int exponent, mantissaLow, mantissaHigh; - /* The pieces extracted from the double. */ - int zeroMantissa; /* Was the mantissa zero? That's special. */ + /* The pieces extracted from the double. */ + int zeroMantissa; /* Was the mantissa zero? That's special. */ /* * Shifts and masks to use with the doubleMeaning variable above. */ -#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ -#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ -#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ +#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ +#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ +#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ /* * Extract the exponent (11 bits) and mantissa (52 bits). Note that we @@ -7974,43 +7990,43 @@ ClassifyDouble( switch (exponent) { case 0: - /* - * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. - */ + /* + * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. + */ - return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; + return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; case EXPONENT_MASK: - /* - * When the exponent is all ones, it's an INF or a NAN. - */ + /* + * When the exponent is all ones, it's an INF or a NAN. + */ - return zeroMantissa ? FP_INFINITE : FP_NAN; + return zeroMantissa ? FP_INFINITE : FP_NAN; default: - /* - * Everything else is a NORMAL double precision float. - */ + /* + * Everything else is a NORMAL double precision float. + */ - return FP_NORMAL; + return FP_NORMAL; } #elif TCL_FPCLASSIFY_MODE == 1 switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: - return FP_ZERO; + return FP_ZERO; case _FPCLASS_NN: case _FPCLASS_PN: - return FP_NORMAL; + return FP_NORMAL; case _FPCLASS_ND: case _FPCLASS_PD: - return FP_SUBNORMAL; + return FP_SUBNORMAL; case _FPCLASS_NINF: case _FPCLASS_PINF: - return FP_INFINITE; + return FP_INFINITE; default: - Tcl_Panic("result of _fpclass() outside documented range!"); + Tcl_Panic("result of _fpclass() outside documented range!"); case _FPCLASS_QNAN: case _FPCLASS_SNAN: - return FP_NAN; + return FP_NAN; } #else /* TCL_FPCLASSIFY_MODE not in (0..3) */ #error "unknown or unexpected TCL_FPCLASSIFY_MODE" @@ -8036,14 +8052,14 @@ ExprIsFiniteFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - type = ClassifyDouble(d); - result = (type != FP_INFINITE && type != FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + type = ClassifyDouble(d); + result = (type != FP_INFINITE && type != FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8067,13 +8083,13 @@ ExprIsInfinityFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_INFINITE); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_INFINITE); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8097,13 +8113,13 @@ ExprIsNaNFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8127,13 +8143,13 @@ ExprIsNormalFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8157,13 +8173,13 @@ ExprIsSubnormalFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_SUBNORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_SUBNORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8187,23 +8203,23 @@ ExprIsUnorderedFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result = 1; + result = 1; } else { - d = *((const double *) ptr); - result = (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result = (ClassifyDouble(d) == FP_NAN); } if (Tcl_GetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result |= 1; + result |= 1; } else { - d = *((const double *) ptr); - result |= (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result |= (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); @@ -8224,39 +8240,39 @@ FloatClassifyObjCmd( int type; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); + Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - goto gotNaN; + goto gotNaN; } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } switch (ClassifyDouble(d)) { case FP_INFINITE: - TclNewLiteralStringObj(objPtr, "infinite"); - break; + TclNewLiteralStringObj(objPtr, "infinite"); + break; case FP_NAN: gotNaN: - TclNewLiteralStringObj(objPtr, "nan"); - break; + TclNewLiteralStringObj(objPtr, "nan"); + break; case FP_NORMAL: - TclNewLiteralStringObj(objPtr, "normal"); - break; + TclNewLiteralStringObj(objPtr, "normal"); + break; case FP_SUBNORMAL: - TclNewLiteralStringObj(objPtr, "subnormal"); - break; + TclNewLiteralStringObj(objPtr, "subnormal"); + break; case FP_ZERO: - TclNewLiteralStringObj(objPtr, "zero"); - break; + TclNewLiteralStringObj(objPtr, "zero"); + break; default: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to classify number: %f", d)); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to classify number: %f", d)); + return TCL_ERROR; } Tcl_SetObjResult(interp, objPtr); return TCL_OK; @@ -8289,10 +8305,10 @@ MathFuncWrongNumArgs( const char *name = TclGetString(objv[0]); const char *tail = name + strlen(name); - while (tail > name+1) { + while (tail > name + 1) { tail--; if (*tail == ':' && tail[-1] == ':') { - name = tail+1; + name = tail + 1; break; } } @@ -8487,14 +8503,14 @@ wrapperNRObjProc( int objc, Tcl_Obj *const objv[]) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; clientData = info->clientData; Tcl_ObjCmdProc2 *proc = info->proc; Tcl_Free(info); if (objc < 0) { objc = -1; } - return proc(clientData, interp, (Tcl_Size)objc, objv); + return proc(clientData, interp, (Tcl_Size) objc, objv); } int @@ -8511,7 +8527,8 @@ Tcl_NRCallObjProc2( } NRE_callback *rootPtr = TOP_CB(interp); - CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *) + Tcl_Alloc(sizeof(CmdWrapperInfo)); info->clientData = clientData; info->proc = objProc; @@ -8555,7 +8572,8 @@ cmdWrapperNreProc( int objc, Tcl_Obj *const objv[]) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; + if (objc < 0) { objc = -1; } @@ -8575,13 +8593,15 @@ Tcl_NRCreateCommand2( * calls. */ Tcl_ObjCmdProc2 *nreProc, /* Object-based function to associate with * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { - CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *) + Tcl_Alloc(sizeof(CmdWrapperInfo)); + info->proc = proc; info->clientData = clientData; info->nreProc = nreProc; @@ -8606,7 +8626,7 @@ Tcl_NRCreateCommand( * calls. */ Tcl_ObjCmdProc *nreProc, /* Object-based function to associate with * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when @@ -8614,7 +8634,7 @@ Tcl_NRCreateCommand( { Command *cmdPtr = (Command *) Tcl_CreateObjCommand(interp, cmdName, proc, clientData, - deleteProc); + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; @@ -8631,8 +8651,8 @@ TclNRCreateCommandInNs( Tcl_CmdDeleteProc *deleteProc) { Command *cmdPtr = (Command *) - TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, - deleteProc); + TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; @@ -8655,7 +8675,7 @@ int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - Tcl_Size objc, /* Number of words in command. */ + Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the @@ -8714,8 +8734,8 @@ TclMarkTailcall( if (iPtr->deferredCallbacks == NULL) { TclNRAddCallback(interp, NRCommand, NULL, NULL, - NULL, NULL); - iPtr->deferredCallbacks = TOP_CB(interp); + NULL, NULL); + iPtr->deferredCallbacks = TOP_CB(interp); } } @@ -8762,12 +8782,12 @@ TclSetTailcall( NRE_callback *runPtr; for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { - if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { - break; - } + if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { + break; + } } if (!runPtr) { - Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); + Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); } runPtr->data[1] = listPtr; } @@ -8803,9 +8823,9 @@ TclNRTailcallObjCmd( } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tailcall can only be called from a proc, lambda or method", -1)); - Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "tailcall can only be called from a proc, lambda or method", -1)); + Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); return TCL_ERROR; } @@ -8815,8 +8835,8 @@ TclNRTailcallObjCmd( */ if (iPtr->varFramePtr->tailcallPtr) { - Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); - iPtr->varFramePtr->tailcallPtr = NULL; + Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); + iPtr->varFramePtr->tailcallPtr = NULL; } /* @@ -8826,19 +8846,19 @@ TclNRTailcallObjCmd( */ if (objc > 1) { - Tcl_Obj *listPtr, *nsObjPtr; - Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; + Tcl_Obj *listPtr, *nsObjPtr; + Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; - /* - * The tailcall data is in a Tcl list: the first element is the - * namespace, the rest the command to be tailcalled. - */ + /* + * The tailcall data is in a Tcl list: the first element is the + * namespace, the rest the command to be tailcalled. + */ - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); - listPtr = Tcl_NewListObj(objc, objv); + nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); + listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); - iPtr->varFramePtr->tailcallPtr = listPtr; + iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } @@ -8860,7 +8880,7 @@ TclNRTailcallEval( int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr; + Tcl_Obj *listPtr = (Tcl_Obj *) data[0], *nsObjPtr; Tcl_Namespace *nsPtr; Tcl_Size objc; Tcl_Obj **objv; @@ -8873,13 +8893,13 @@ TclNRTailcallEval( } if (result != TCL_OK) { - /* - * Tailcall execution was preempted, eg by an intervening catch or by - * a now-gone namespace: cleanup and return. - */ + /* + * Tailcall execution was preempted, eg by an intervening catch or by + * a now-gone namespace: cleanup and return. + */ Tcl_DecrRefCount(listPtr); - return result; + return result; } /* @@ -8889,7 +8909,7 @@ TclNRTailcallEval( TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; - return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL); + return TclNREvalObjv(interp, objc - 1, objv + 1, 0, NULL); } int @@ -8966,7 +8986,7 @@ TclNRYieldObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yield can only be called in a coroutine", -1)); + "yield can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } @@ -8977,7 +8997,7 @@ TclNRYieldObjCmd( NRE_ASSERT(!COR_IS_SUSPENDED(corPtr)); TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - clientData, NULL, NULL); + clientData, NULL, NULL); return TCL_OK; } @@ -8999,17 +9019,17 @@ TclNRYieldToObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto can only be called in a coroutine", -1)); + "yieldto can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } if (((Namespace *) nsPtr)->flags & NS_DYING) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto called in deleted namespace", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", (char *)NULL); - return TCL_ERROR; + return TCL_ERROR; } /* @@ -9041,7 +9061,7 @@ RewindCoroutineCallback( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - return Tcl_RestoreInterpState(interp, (Tcl_InterpState)data[0]); + return Tcl_RestoreInterpState(interp, (Tcl_InterpState) data[0]); } static int @@ -9066,7 +9086,7 @@ static void DeleteCoroutine( void *clientData) { - CoroutineData *corPtr = (CoroutineData *)clientData; + CoroutineData *corPtr = (CoroutineData *) clientData; Tcl_Interp *interp = corPtr->eePtr->interp; NRE_callback *rootPtr = TOP_CB(interp); @@ -9081,7 +9101,7 @@ NRCoroutineCallerCallback( Tcl_Interp *interp, int result) { - CoroutineData *corPtr = (CoroutineData *)data[0]; + CoroutineData *corPtr = (CoroutineData *) data[0]; Command *cmdPtr = corPtr->cmdPtr; /* @@ -9127,7 +9147,7 @@ NRCoroutineExitCallback( Tcl_Interp *interp, int result) { - CoroutineData *corPtr = (CoroutineData *)data[0]; + CoroutineData *corPtr = (CoroutineData *) data[0]; Command *cmdPtr = corPtr->cmdPtr; /* @@ -9174,14 +9194,14 @@ NRCoroutineExitCallback( * * TclNRCoroutineActivateCallback -- * - * This is the workhorse for coroutines: it implements both yield and - * resume. + * This is the workhorse for coroutines: it implements both yield and + * resume. * - * It is important that both be implemented in the same callback: the - * detection of the impossibility to suspend due to a busy C-stack relies - * on the precise position of a local variable in the stack. We do not - * want the compiler to play tricks on us, either by moving things around - * or inlining. + * It is important that both be implemented in the same callback: the + * detection of the impossibility to suspend due to a busy C-stack relies + * on the precise position of a local variable in the stack. We do not + * want the compiler to play tricks on us, either by moving things around + * or inlining. * *---------------------------------------------------------------------- */ @@ -9192,46 +9212,46 @@ TclNRCoroutineActivateCallback( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - CoroutineData *corPtr = (CoroutineData *)data[0]; + CoroutineData *corPtr = (CoroutineData *) data[0]; void *stackLevel = TclGetCStackPtr(); if (!corPtr->stackLevel) { - /* - * -- Coroutine is suspended -- - * Push the callback to restore the caller's context on yield or - * return. - */ - - TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); - - /* - * Record the stackLevel at which the resume is happening, then swap - * the interp's environment to make it suitable to run this coroutine. - */ - - corPtr->stackLevel = stackLevel; - Tcl_Size numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = iPtr->numLevels; - - SAVE_CONTEXT(corPtr->caller); - corPtr->callerEEPtr = iPtr->execEnvPtr; - RESTORE_CONTEXT(corPtr->running); - iPtr->execEnvPtr = corPtr->eePtr; - iPtr->numLevels += numLevels; + /* + * -- Coroutine is suspended -- + * Push the callback to restore the caller's context on yield or + * return. + */ + + TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, + NULL, NULL, NULL); + + /* + * Record the stackLevel at which the resume is happening, then swap + * the interp's environment to make it suitable to run this coroutine. + */ + + corPtr->stackLevel = stackLevel; + Tcl_Size numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = iPtr->numLevels; + + SAVE_CONTEXT(corPtr->caller); + corPtr->callerEEPtr = iPtr->execEnvPtr; + RESTORE_CONTEXT(corPtr->running); + iPtr->execEnvPtr = corPtr->eePtr; + iPtr->numLevels += numLevels; } else { - /* - * Coroutine is active: yield - */ + /* + * Coroutine is active: yield + */ - if (corPtr->stackLevel != stackLevel) { + if (corPtr->stackLevel != stackLevel) { NRE_callback *runPtr; iPtr->execEnvPtr = corPtr->callerEEPtr; if (corPtr->yieldPtr) { for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { if (runPtr->data[1] == corPtr->yieldPtr) { - Tcl_DecrRefCount((Tcl_Obj *)runPtr->data[1]); + Tcl_DecrRefCount((Tcl_Obj *) runPtr->data[1]); runPtr->data[1] = NULL; corPtr->yieldPtr = NULL; break; @@ -9240,31 +9260,30 @@ TclNRCoroutineActivateCallback( } iPtr->execEnvPtr = corPtr->eePtr; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot yield: C stack busy", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", + (char *)NULL); + return TCL_ERROR; + } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot yield: C stack busy", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", - (char *)NULL); - return TCL_ERROR; - } - - void *type = data[1]; - if (type == CORO_ACTIVATE_YIELD) { - corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; - } else if (type == CORO_ACTIVATE_YIELDM) { - corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; - } else { - Tcl_Panic("Yield received an option which is not implemented"); - } + void *type = data[1]; + if (type == CORO_ACTIVATE_YIELD) { + corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; + } else if (type == CORO_ACTIVATE_YIELDM) { + corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; + } else { + Tcl_Panic("Yield received an option which is not implemented"); + } corPtr->yieldPtr = NULL; - corPtr->stackLevel = NULL; + corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return TCL_OK; @@ -9275,7 +9294,7 @@ TclNRCoroutineActivateCallback( * * TclNREvalList -- * - * Callback to invoke command as list, used in order to delayed + * Callback to invoke command as list, used in order to delayed * processing of canonical list command in sane environment. * *---------------------------------------------------------------------- @@ -9289,7 +9308,7 @@ TclNREvalList( { Tcl_Size objc; Tcl_Obj **objv; - Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *) data[0]; Tcl_IncrRefCount(listPtr); @@ -9304,7 +9323,7 @@ TclNREvalList( * * CoroTypeObjCmd -- * - * Implementation of [::tcl::unsupported::corotype] command. + * Implementation of [::tcl::unsupported::corotype] command. * *---------------------------------------------------------------------- */ @@ -9330,11 +9349,11 @@ CoroTypeObjCmd( cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only get coroutine type of a coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objv[1]), (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only get coroutine type of a coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objv[1]), (char *)NULL); + return TCL_ERROR; } /* @@ -9342,10 +9361,10 @@ CoroTypeObjCmd( * future. */ - corPtr = (CoroutineData *)cmdPtr->objClientData; + corPtr = (CoroutineData *) cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); + return TCL_OK; } /* @@ -9355,16 +9374,16 @@ CoroTypeObjCmd( switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); + return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); + return TCL_OK; default: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown coroutine type", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unknown coroutine type", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); + return TCL_ERROR; } } @@ -9373,7 +9392,7 @@ CoroTypeObjCmd( * * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd -- * - * Implementation of [coroinject] and [coroprobe] commands. + * Implementation of [coroinject] and [coroprobe] commands. * *---------------------------------------------------------------------- */ @@ -9391,12 +9410,12 @@ GetCoroutineFromObj( Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objPtr), (char *)NULL); - return NULL; + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objPtr), (char *) NULL); + return NULL; } - return (CoroutineData *)cmdPtr->objClientData; + return (CoroutineData *) cmdPtr->objClientData; } static int @@ -9419,15 +9438,15 @@ TclNRCoroInjectObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9438,7 +9457,7 @@ TclNRCoroInjectObjCmd( ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; @@ -9464,16 +9483,16 @@ TclNRCoroProbeObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a probe command into a coroutine"); + "can only inject a probe command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a probe command into a suspended coroutine", - -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a probe command into a suspended coroutine", + -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9484,7 +9503,7 @@ TclNRCoroProbeObjCmd( ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); iPtr->execEnvPtr = savedEEPtr; /* @@ -9495,7 +9514,7 @@ TclNRCoroProbeObjCmd( */ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); /* * Record the stackLevel at which the resume is happening, then swap @@ -9523,18 +9542,18 @@ TclNRCoroProbeObjCmd( * * InjectHandler, InjectHandlerPostProc -- * - * Part of the implementation of [coroinject] and [coroprobe]. These are - * run inside the context of the coroutine being injected/probed into. + * Part of the implementation of [coroinject] and [coroprobe]. These are + * run inside the context of the coroutine being injected/probed into. * - * InjectHandler runs a script (possibly adding arguments) in the context - * of the coroutine. The script is specified as a one-shot list (with - * reference count equal to 1) in data[1]. This function also arranges - * for InjectHandlerPostProc to be the part that runs after the script - * completes. + * InjectHandler runs a script (possibly adding arguments) in the context + * of the coroutine. The script is specified as a one-shot list (with + * reference count equal to 1) in data[1]. This function also arranges + * for InjectHandlerPostProc to be the part that runs after the script + * completes. * - * InjectHandlerPostProc cleans up after InjectHandler (deleting the - * list) and, for the [coroprobe] command *only*, yields back to the - * caller context (i.e., where [coroprobe] was run). + * InjectHandlerPostProc cleans up after InjectHandler (deleting the + * list) and, for the [coroprobe] command *only*, yields back to the + * caller context (i.e., where [coroprobe] was run). *s *---------------------------------------------------------------------- */ @@ -9545,8 +9564,8 @@ InjectHandler( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - CoroutineData *corPtr = (CoroutineData *)data[0]; - Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; + CoroutineData *corPtr = (CoroutineData *) data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *) data[1]; Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; Tcl_Size objc; @@ -9581,7 +9600,7 @@ InjectHandler( Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr, - INT2PTR(nargs), isProbe); + INT2PTR(nargs), isProbe); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } @@ -9592,8 +9611,8 @@ InjectHandlerPostCall( Tcl_Interp *interp, int result) { - CoroutineData *corPtr = (CoroutineData *)data[0]; - Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; + CoroutineData *corPtr = (CoroutineData *) data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *) data[1]; Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; @@ -9611,16 +9630,16 @@ InjectHandlerPostCall( */ if (isProbe) { - if (result == TCL_ERROR) { - Tcl_AddErrorInfo(interp, - "\n (injected coroutine probe command)"); - } - corPtr->nargs = nargs; - corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + if (result == TCL_ERROR) { + Tcl_AddErrorInfo(interp, + "\n (injected coroutine probe command)"); + } + corPtr->nargs = nargs; + corPtr->stackLevel = NULL; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return result; } @@ -9630,7 +9649,7 @@ InjectHandlerPostCall( * * NRInjectObjCmd -- * - * Implementation of [::tcl::unsupported::inject] command. + * Implementation of [::tcl::unsupported::inject] command. * *---------------------------------------------------------------------- */ @@ -9656,15 +9675,15 @@ NRInjectObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9673,8 +9692,8 @@ NRInjectObjCmd( */ iPtr->execEnvPtr = corPtr->eePtr; - TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2), - NULL, NULL, NULL); + TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc - 2, objv + 2), + NULL, NULL, NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; @@ -9687,12 +9706,12 @@ TclNRInterpCoroutine( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - CoroutineData *corPtr = (CoroutineData *)clientData; + CoroutineData *corPtr = (CoroutineData *) clientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "coroutine \"%s\" is already running", - TclGetString(objv[0]))); + "coroutine \"%s\" is already running", + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", (char *)NULL); return TCL_ERROR; } @@ -9705,31 +9724,31 @@ TclNRInterpCoroutine( switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - if (objc == 2) { - Tcl_SetObjResult(interp, objv[1]); - } else if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); - return TCL_ERROR; - } - break; + if (objc == 2) { + Tcl_SetObjResult(interp, objv[1]); + } else if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); + return TCL_ERROR; + } + break; default: - if (corPtr->nargs + 1 != objc) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong coro nargs; how did we get here? " - "not implemented!", -1)); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); - return TCL_ERROR; - } - /* fallthrough */ + if (corPtr->nargs + 1 != objc) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong coro nargs; how did we get here? " + "not implemented!", -1)); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); + return TCL_ERROR; + } + /* fallthrough */ case COROUTINE_ARGUMENTS_ARBITRARY: - if (objc > 1) { - Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); - } - break; + if (objc > 1) { + Tcl_SetObjResult(interp, Tcl_NewListObj(objc - 1, objv + 1)); + } + break; } TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } @@ -9738,8 +9757,8 @@ TclNRInterpCoroutine( * * TclNRCoroutineObjCmd -- * - * Implementation of [coroutine] command; see documentation for - * description of what this does. + * Implementation of [coroutine] command; see documentation for + * description of what this does. * *---------------------------------------------------------------------- */ @@ -9755,7 +9774,7 @@ TclNRCoroutineObjCmd( CoroutineData *corPtr; const char *procName, *simpleName; Namespace *nsPtr, *altNsPtr, *cxtNsPtr, - *inNsPtr = (Namespace *)TclGetCurrentNamespace(interp); + *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp); Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr; if (objc < 3) { @@ -9769,16 +9788,16 @@ TclNRCoroutineObjCmd( if (nsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": unknown namespace", - procName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); + "can't create procedure \"%s\": unknown namespace", + procName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); return TCL_ERROR; } if (simpleName == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": bad procedure name", - procName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); + "can't create procedure \"%s\": bad procedure name", + procName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); return TCL_ERROR; } @@ -9787,10 +9806,10 @@ TclNRCoroutineObjCmd( * struct and create the corresponding command. */ - corPtr = (CoroutineData *)Tcl_Alloc(sizeof(CoroutineData)); + corPtr = (CoroutineData *) Tcl_Alloc(sizeof(CoroutineData)); cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName, - (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, + (Tcl_Namespace *) nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine); corPtr->cmdPtr = cmdPtr; @@ -9809,7 +9828,8 @@ TclNRCoroutineObjCmd( Tcl_HashSearch hSearch; Tcl_HashEntry *hePtr; - corPtr->lineLABCPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + corPtr->lineLABCPtr = (Tcl_HashTable *) + Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch); @@ -9870,7 +9890,7 @@ TclNRCoroutineObjCmd( */ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } -- cgit v0.12 From fc2eda45ffeb2c6522b5fae9392b98782f50b7cf Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 10 May 2024 13:51:31 +0000 Subject: Funcs without args must explicitly take void Otherwise C compilers operate in a weird legacy mode which we never want. --- generic/tclClockFmt.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 423b64a..0afc458 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -3567,7 +3567,7 @@ ClockFrmScnClearCaches(void) } void -ClockFrmScnFinalize() +ClockFrmScnFinalize(void) { if (!initialized) { return; -- cgit v0.12 From dbc69d01bcf0c73127854426b8a6bdd71b86c9f2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 10 May 2024 14:42:03 +0000 Subject: (backport): Funcs without args must explicitly take void --- generic/tclClockFmt.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 11956cc..9b32020 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -621,7 +621,7 @@ ClockFmtScnStorageDelete( { Tcl_HashEntry *hPtr = HashEntry4FmtScn(fss); /* - * This will delete a hash entry and call "Tcl_Free" for storage self, if + * This will delete a hash entry and call "ckfree" for storage self, if * some additionally handling required, freeEntryProc can be used instead */ Tcl_DeleteHashEntry(hPtr); @@ -3566,7 +3566,7 @@ ClockFrmScnClearCaches(void) } void -ClockFrmScnFinalize() +ClockFrmScnFinalize(void) { if (!initialized) { return; -- cgit v0.12 From 897d057168f712735f662742168e1cdb07adbfa1 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 10 May 2024 15:40:16 +0000 Subject: More whitespace cleanup --- generic/tcl.h | 182 +++++++++++++++++++++++--------------------- generic/tclBasic.c | 6 +- generic/tclBinary.c | 1 - generic/tclCkalloc.c | 39 +++++----- generic/tclClock.c | 5 -- generic/tclCmdAH.c | 15 ++-- generic/tclCmdIL.c | 1 - generic/tclCompCmds.c | 4 - generic/tclCompCmdsSZ.c | 1 - generic/tclCompExpr.c | 2 +- generic/tclDisassemble.c | 19 +++-- generic/tclEncoding.c | 24 +++--- generic/tclEnv.c | 9 +-- generic/tclEvent.c | 2 - generic/tclExecute.c | 2 - generic/tclHash.c | 4 +- generic/tclIO.c | 27 +++---- generic/tclIO.h | 4 +- generic/tclIOCmd.c | 1 - generic/tclIORChan.c | 57 +++++++------- generic/tclIORTrans.c | 28 ++++--- generic/tclIOSock.c | 8 +- generic/tclIOUtil.c | 63 +++++++-------- generic/tclInt.h | 1 - generic/tclInterp.c | 5 +- generic/tclListObj.c | 5 +- generic/tclLoad.c | 31 +++----- generic/tclNamesp.c | 5 +- generic/tclOOCall.c | 1 - generic/tclObj.c | 2 - generic/tclPanic.c | 1 - generic/tclParse.c | 2 +- generic/tclPathObj.c | 2 - generic/tclProc.c | 61 ++++++++------- generic/tclProcess.c | 4 +- generic/tclRegexp.c | 25 +++--- generic/tclStrToD.c | 3 - generic/tclStringObj.c | 2 - generic/tclStringRep.h | 1 - generic/tclStubLibTbl.c | 10 +-- generic/tclThread.c | 1 - generic/tclTomMathStubLib.c | 1 - generic/tclTrace.c | 1 - generic/tclUtf.c | 2 - generic/tclUtil.c | 8 +- generic/tclZipfs.c | 27 ++++--- macosx/tclMacOSXNotify.c | 1 - unix/tclKqueueNotfy.c | 3 +- unix/tclLoadNext.c | 1 - unix/tclLoadOSF.c | 1 - unix/tclUnixInit.c | 1 - win/tclWinChan.c | 5 +- win/tclWinConsole.c | 5 +- win/tclWinFCmd.c | 1 - win/tclWinInt.h | 4 +- win/tclWinPipe.c | 1 - win/tclWinPort.h | 3 - win/tclWinSerial.c | 2 - win/tclWinThrd.c | 24 +++--- win/tclWinTime.c | 1 - 60 files changed, 328 insertions(+), 430 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index e40e8a9..947e4a7 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -48,15 +48,15 @@ extern "C" { */ #if !defined(TCL_MAJOR_VERSION) -# define TCL_MAJOR_VERSION 9 +# define TCL_MAJOR_VERSION 9 #endif #if TCL_MAJOR_VERSION == 9 -# define TCL_MINOR_VERSION 0 -# define TCL_RELEASE_LEVEL TCL_BETA_RELEASE -# define TCL_RELEASE_SERIAL 2 +# define TCL_MINOR_VERSION 0 +# define TCL_RELEASE_LEVEL TCL_BETA_RELEASE +# define TCL_RELEASE_SERIAL 2 -# define TCL_VERSION "9.0" -# define TCL_PATCH_LEVEL "9.0b2" +# define TCL_VERSION "9.0" +# define TCL_PATCH_LEVEL "9.0b2" #endif /* TCL_MAJOR_VERSION */ #if defined(RC_INVOKED) @@ -90,7 +90,8 @@ extern "C" { * Special macro to define mutexes. */ -#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name; +#define TCL_DECLARE_MUTEX(name) \ + static Tcl_Mutex name; /* * Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and @@ -464,9 +465,9 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData); typedef struct Tcl_RegExpIndices { #if TCL_MAJOR_VERSION > 8 - Tcl_Size start; /* Character offset of first character in + Tcl_Size start; /* Character offset of first character in * match. */ - Tcl_Size end; /* Character offset of first character after + Tcl_Size end; /* Character offset of first character after * the match. */ #else long start; @@ -475,11 +476,11 @@ typedef struct Tcl_RegExpIndices { } Tcl_RegExpIndices; typedef struct Tcl_RegExpInfo { - Tcl_Size nsubs; /* Number of subexpressions in the compiled + Tcl_Size nsubs; /* Number of subexpressions in the compiled * expression. */ Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ #if TCL_MAJOR_VERSION > 8 - Tcl_Size extendStart; /* The offset at which a subsequent match + Tcl_Size extendStart; /* The offset at which a subsequent match * might begin. */ #else long extendStart; @@ -615,28 +616,25 @@ typedef void (Tcl_ServiceModeHookProc) (int mode); typedef void *(Tcl_InitNotifierProc) (void); typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); - + /* Abstract List functions */ -typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr); -typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size index, struct Tcl_Obj** elemObj); -typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size fromIdx, Tcl_Size toIdx, - struct Tcl_Obj **newObjPtr); -typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - struct Tcl_Obj **newObjPtr); -typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size *objcptr, struct Tcl_Obj ***objvptr); -typedef struct Tcl_Obj* (Tcl_ObjTypeSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size indexCount, - struct Tcl_Obj *const indexArray[], - struct Tcl_Obj *valueObj); -typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj, - Tcl_Size first, Tcl_Size numToDelete, - Tcl_Size numToInsert, - struct Tcl_Obj *const insertObjs[]); -typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj, - struct Tcl_Obj *listObj, int *boolResult); +typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr); +typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size index, struct Tcl_Obj** elemObj); +typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size fromIdx, Tcl_Size toIdx, struct Tcl_Obj **newObjPtr); +typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, + struct Tcl_Obj *listPtr, struct Tcl_Obj **newObjPtr); +typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, + struct Tcl_Obj *listPtr, Tcl_Size *objcptr, struct Tcl_Obj ***objvptr); +typedef struct Tcl_Obj *(Tcl_ObjTypeSetElement) (Tcl_Interp *interp, + struct Tcl_Obj *listPtr, Tcl_Size indexCount, + struct Tcl_Obj *const indexArray[], struct Tcl_Obj *valueObj); +typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, + struct Tcl_Obj *listObj, Tcl_Size first, Tcl_Size numToDelete, + Tcl_Size numToInsert, struct Tcl_Obj *const insertObjs[]); +typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, + struct Tcl_Obj *valueObj, struct Tcl_Obj *listObj, int *boolResult); #ifndef TCL_NO_DEPRECATED # define Tcl_PackageInitProc Tcl_LibraryInitProc @@ -670,33 +668,36 @@ typedef struct Tcl_ObjType { size_t version; /* List emulation functions - ObjType Version 1 */ - Tcl_ObjTypeLengthProc *lengthProc; /* Return the [llength] of the - ** AbstractList */ - Tcl_ObjTypeIndexProc *indexProc; /* Return a value (Tcl_Obj) for - ** [lindex $al $index] */ - Tcl_ObjTypeSliceProc *sliceProc; /* Return an AbstractList for - ** [lrange $al $start $end] */ - Tcl_ObjTypeReverseProc *reverseProc; /* Return an AbstractList for - ** [lreverse $al] */ - Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in - ** the list */ - Tcl_ObjTypeSetElement *setElementProc; /* Replace the element at the indicie - ** with the given valueObj. */ - Tcl_ObjTypeReplaceProc *replaceProc; /* Replace subset with subset */ - Tcl_ObjTypeInOperatorProc *inOperProc; /* "in" and "ni" expr list - ** operation Determine if the given - ** string value matches an element in - ** the list */ + Tcl_ObjTypeLengthProc *lengthProc; + /* Return the [llength] of the AbstractList */ + Tcl_ObjTypeIndexProc *indexProc; + /* Return a value (Tcl_Obj) at a given index */ + Tcl_ObjTypeSliceProc *sliceProc; + /* Return an AbstractList for + * [lrange $al $start $end] */ + Tcl_ObjTypeReverseProc *reverseProc; + /* Return an AbstractList for [lreverse $al] */ + Tcl_ObjTypeGetElements *getElementsProc; + /* Return an objv[] of all elements in the list */ + Tcl_ObjTypeSetElement *setElementProc; + /* Replace the element at the indicies with the + * given valueObj. */ + Tcl_ObjTypeReplaceProc *replaceProc; + /* Replace sublist with another sublist */ + Tcl_ObjTypeInOperatorProc *inOperProc; + /* "in" and "ni" expr list operation. + * Determine if the given string value matches + * an element in the list. */ #endif } Tcl_ObjType; #if TCL_MAJOR_VERSION > 8 # define TCL_OBJTYPE_V0 0, \ - 0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */ + 0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */ # define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \ - a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */ + a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */ # define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType), \ - a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */ + a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */ #else # define TCL_OBJTYPE_V0 /* just empty */ #endif @@ -749,9 +750,9 @@ typedef struct Tcl_Obj { * corresponds to the type of the object's * internal rep. NULL indicates the object has * no internal rep (has no type). */ - Tcl_ObjInternalRep internalRep; /* The internal representation: */ + Tcl_ObjInternalRep internalRep; + /* The internal representation: */ } Tcl_Obj; - /* *---------------------------------------------------------------------------- @@ -767,7 +768,7 @@ typedef struct Tcl_Namespace { * is an synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - void *clientData; /* Arbitrary value associated with this + void *clientData; /* Arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Function invoked when deleting the @@ -841,11 +842,11 @@ typedef struct { Tcl_ObjCmdProc *objProc; /* Command's object-based function. */ void *objClientData; /* ClientData for object proc. */ Tcl_CmdProc *proc; /* Command's string-based function. */ - void *clientData; /* ClientData for string proc. */ + void *clientData; /* ClientData for string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Function to call when command is * deleted. */ - void *deleteData; /* Value to pass to deleteProc (usually the + void *deleteData; /* Value to pass to deleteProc (usually the * same as clientData). */ Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this * command. Note that Tcl_SetCmdInfo will not @@ -964,7 +965,7 @@ typedef struct Tcl_DString { * TCL_CANCEL_UNWIND: Magical Tcl_CancelEval mode that causes the * stack for the script in progress to be * completely unwound. - * TCL_EVAL_NOERR: Do no exception reporting at all, just return + * TCL_EVAL_NOERR: Do no exception reporting at all, just return * as the caller will report. */ @@ -1077,7 +1078,7 @@ struct Tcl_HashEntry { * or NULL for end of chain. */ Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ size_t hash; /* Hash value. */ - void *clientData; /* Application stores something here with + void *clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ char *oneWordValue; /* One-word value for key. */ @@ -1173,11 +1174,11 @@ struct Tcl_HashTable { Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - Tcl_Size numBuckets; /* Total number of buckets allocated at + Tcl_Size numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ - Tcl_Size numEntries; /* Total number of entries present in + Tcl_Size numEntries; /* Total number of entries present in * table. */ - Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be + Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ #if TCL_MAJOR_VERSION > 8 size_t mask; /* Mask value used in hashing function. */ @@ -1186,7 +1187,7 @@ struct Tcl_HashTable { * Designed to use high-order bits of * randomized keys. */ #if TCL_MAJOR_VERSION < 9 - int mask; /* Mask value used in hashing function. */ + int mask; /* Mask value used in hashing function. */ #endif int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, @@ -1776,8 +1777,8 @@ typedef struct Tcl_Token { int type; /* Type of token, such as TCL_TOKEN_WORD; see * below for valid types. */ const char *start; /* First character in token. */ - Tcl_Size size; /* Number of bytes in token. */ - Tcl_Size numComponents; /* If this token is composed of other tokens, + Tcl_Size size; /* Number of bytes in token. */ + Tcl_Size numComponents; /* If this token is composed of other tokens, * this field tells how many of them there are * (including components of components, etc.). * The component tokens immediately follow @@ -1891,13 +1892,13 @@ typedef struct Tcl_Token { typedef struct Tcl_Parse { const char *commentStart; /* Pointer to # that begins the first of one * or more comments preceding the command. */ - Tcl_Size commentSize; /* Number of bytes in comments (up through + Tcl_Size commentSize; /* Number of bytes in comments (up through * newline character that terminates the last * comment). If there were no comments, this * field is 0. */ const char *commandStart; /* First character in first word of * command. */ - Tcl_Size commandSize; /* Number of bytes in command, including first + Tcl_Size commandSize; /* Number of bytes in command, including first * character of first word, up through the * terminating newline, close bracket, or * semicolon. */ @@ -1967,7 +1968,7 @@ typedef struct Tcl_EncodingType { Tcl_FreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ - void *clientData; /* Arbitrary value associated with encoding + void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ Tcl_Size nullSize; /* Number of zero bytes that signify * end-of-string in this encoding. This number @@ -2173,7 +2174,7 @@ typedef struct { * depends on type.*/ const char *helpStr; /* Documentation message describing this * option. */ - void *clientData; /* Word to pass to function callbacks. */ + void *clientData; /* Word to pass to function callbacks. */ } Tcl_ArgvInfo; /* @@ -2293,9 +2294,9 @@ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, */ #if TCL_MAJOR_VERSION > 8 -# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) +# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) #else -# define TCL_STUB_MAGIC ((int) 0xFCA3BACF) +# define TCL_STUB_MAGIC ((int) 0xFCA3BACF) #endif /* @@ -2312,7 +2313,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char * TclInitStubTable(const char *version); void * TclStubCall(void *arg); #if defined(_WIN32) - TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...); + TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...); #else # define Tcl_ConsolePanic ((Tcl_PanicProc *)NULL) #endif @@ -2360,7 +2361,8 @@ void * TclStubCall(void *arg); * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ -#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ +#define Tcl_Main(argc, argv, proc) \ + Tcl_MainEx(argc, argv, proc, \ ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp()))) EXTERN TCL_NORETURN void Tcl_MainEx(Tcl_Size argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); @@ -2379,9 +2381,9 @@ EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp, #ifndef TCL_NO_DEPRECATED # define Tcl_StaticPackage Tcl_StaticLibrary #endif -EXTERN Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc); +EXTERN Tcl_ExitProc * Tcl_SetExitProc(Tcl_ExitProc *proc); #ifdef _WIN32 -EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv); +EXTERN const char * TclZipfs_AppHook(int *argc, wchar_t ***argv); #else EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); #endif @@ -2501,7 +2503,11 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); # define Tcl_BounceRefCount(objPtr) \ TclBounceRefCount(objPtr, __FILE__, __LINE__) -static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line) +static inline void +TclBounceRefCount( + Tcl_Obj* objPtr, + const char* fn, + int line) { if (objPtr) { if ((objPtr)->refCount == 0) { @@ -2519,11 +2525,11 @@ static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line) */ # undef Tcl_DecrRefCount # define Tcl_DecrRefCount(objPtr) \ - do { \ - Tcl_Obj *_objPtr = (objPtr); \ - if (_objPtr->refCount-- <= 1) { \ - TclFreeObj(_objPtr); \ - } \ + do { \ + Tcl_Obj *_objPtr = (objPtr); \ + if (_objPtr->refCount-- <= 1) { \ + TclFreeObj(_objPtr); \ + } \ } while(0) # undef Tcl_IsShared # define Tcl_IsShared(objPtr) \ @@ -2534,10 +2540,12 @@ static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line) * This will release the obj if there is no referece count, * otherwise let it be. */ -# define Tcl_BounceRefCount(objPtr) \ +# define Tcl_BounceRefCount(objPtr) \ TclBounceRefCount(objPtr); -static inline void TclBounceRefCount(Tcl_Obj* objPtr) +static inline void +TclBounceRefCount( + Tcl_Obj* objPtr) { if (objPtr) { if ((objPtr)->refCount == 0) { @@ -2589,10 +2597,10 @@ static inline void TclBounceRefCount(Tcl_Obj* objPtr) #define Tcl_GetHashValue(h) ((h)->clientData) #define Tcl_SetHashValue(h, value) ((h)->clientData = (void *)(value)) #define Tcl_GetHashKey(tablePtr, h) \ - ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ - (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ - ? (h)->key.oneWordValue \ - : (h)->key.string)) + ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ + (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ + ? (h)->key.oneWordValue \ + : (h)->key.string)) /* * Macros to use for clients to use to invoke find and create functions for diff --git a/generic/tclBasic.c b/generic/tclBasic.c index ed1ad58..3940d4b 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2740,10 +2740,9 @@ Tcl_CreateObjCommand2( * name. */ void *clientData, /* Arbitrary value to pass to object * function. */ - Tcl_CmdDeleteProc *deleteProc + Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ -) { CmdWrapperInfo *info = (CmdWrapperInfo *) Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = proc; @@ -2768,10 +2767,9 @@ Tcl_CreateObjCommand( * name. */ void *clientData, /* Arbitrary value to pass to object * function. */ - Tcl_CmdDeleteProc *deleteProc + Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ -) { Interp *iPtr = (Interp *) interp; Namespace *nsPtr; diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 329cfe2..d95452b 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -557,7 +557,6 @@ TclNarrowToBytes( Tcl_IncrRefCount(objPtr); return objPtr; } - /* *---------------------------------------------------------------------- diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 1c12106..a95fc83 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -719,7 +719,6 @@ Tcl_AttemptDbCkrealloc( Tcl_DbCkfree(ptr, file, line); return newPtr; } - /* *---------------------------------------------------------------------- @@ -1010,7 +1009,6 @@ Tcl_InitMemory( Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL); } - #else /* TCL_MEM_DEBUG */ /* This is the !TCL_MEM_DEBUG case */ @@ -1018,7 +1016,6 @@ Tcl_InitMemory( #undef Tcl_InitMemory #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory - /* *---------------------------------------------------------------------- @@ -1253,11 +1250,11 @@ TclDumpMemoryInfo( */ void * TclAllocElemsEx( - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored - here if non-NULL. Only modified on success */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if + * non-NULL. Only modified on success */ { void *ptr = TclAttemptReallocElemsEx( NULL, elemCount, elemSize, leadSize, capacityPtr); @@ -1288,13 +1285,13 @@ TclAllocElemsEx( */ void * TclAttemptReallocElemsEx( - void *oldPtr, /* Pointer to memory block to reallocate or - * NULL to indicate this is a new allocation */ - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored - here if non-NULL. Only modified on success */ + void *oldPtr, /* Pointer to memory block to reallocate or + * NULL to indicate this is a new allocation */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if + * non-NULL. Only modified on success */ { void *ptr; Tcl_Size limit; @@ -1358,12 +1355,12 @@ TclAttemptReallocElemsEx( */ void * TclReallocElemsEx( - void *oldPtr, /* Pointer to memory block to reallocate */ - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored - here if non-NULL. Only modified on success */ + void *oldPtr, /* Pointer to memory block to reallocate */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if + * non-NULL. Only modified on success */ { void *ptr = TclAttemptReallocElemsEx( oldPtr, elemCount, elemSize, leadSize, capacityPtr); diff --git a/generic/tclClock.c b/generic/tclClock.c index 2cfa4a5..412f616 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1964,7 +1964,6 @@ ConvertLocalToUTC( ltzoc->tzOffset = fields->tzOffset; } - /* check DST-hole: if retrieved seconds is out of range */ if (ltzoc->rangesVal[0] > seconds || seconds >= ltzoc->rangesVal[1]) { dstHole: @@ -2900,7 +2899,6 @@ GetJulianDayFromEraYearMonthDay( *---------------------------------------------------------------------- */ - void GetJulianDayFromEraYearDay( TclDateFields *fields, /* Date to convert */ @@ -4250,7 +4248,6 @@ ClockCalcRelTime( return TCL_OK; } - /*---------------------------------------------------------------------- * @@ -4309,8 +4306,6 @@ ClockWeekdaysOffs( return offs; } - - /*---------------------------------------------------------------------- * diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 288271b..ab5fbb0 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -425,14 +425,13 @@ TclInitEncodingCmd( */ static int EncodingConvertParseOptions( - Tcl_Interp *interp, /* For error messages. May be NULL */ - int objc, /* Number of arguments */ - Tcl_Obj *const objv[], /* Argument objects as passed to command. */ - Tcl_Encoding *encPtr, /* Where to store the encoding */ - Tcl_Obj **dataObjPtr, /* Where to store ptr to Tcl_Obj containing data */ - int *profilePtr, /* Bit mask of encoding option profile */ - Tcl_Obj **failVarPtr /* Where to store -failindex option value */ -) + Tcl_Interp *interp, /* For error messages. May be NULL */ + int objc, /* Number of arguments */ + Tcl_Obj *const objv[], /* Argument objects as passed to command. */ + Tcl_Encoding *encPtr, /* Where to store the encoding */ + Tcl_Obj **dataObjPtr, /* Where to store ptr to Tcl_Obj containing data */ + int *profilePtr, /* Bit mask of encoding option profile */ + Tcl_Obj **failVarPtr) /* Where to store -failindex option value */ { static const char *const options[] = {"-profile", "-failindex", NULL}; enum convertfromOptions { PROFILE, FAILINDEX } optIndex; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index c46ab60..37c9822 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -5290,7 +5290,6 @@ SortCompare( return 0; } - objPtr1 = elemPtr1->collationKey.objValuePtr; objPtr2 = elemPtr2->collationKey.objValuePtr; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 99a97ad..bad58f6 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -657,7 +657,6 @@ TclCompileCatchCmd( } ExceptionRangeEnds(envPtr, range); - /* * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result, * and jump around the "error case" code. @@ -679,7 +678,6 @@ TclCompileCatchCmd( TclEmitOpcode( INST_POP, envPtr); } - /* Stack at this point is empty */ TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); @@ -791,7 +789,6 @@ TclCompileClockClicksCmd( } return TCL_OK; } - /*---------------------------------------------------------------------- * @@ -2851,7 +2848,6 @@ CompileEachloopCmd( int varIndex; Tcl_Size length; - Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); bytes = TclGetStringFromObj(varNameObj, &length); varIndex = LocalScalar(bytes, length, envPtr); diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 98a39f9..bc37155 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -101,7 +101,6 @@ const AuxDataType tclJumptableInfoType = { if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));} #define INVOKE(name) \ TclEmitInvoke(envPtr,INST_##name) - /* *---------------------------------------------------------------------- diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index c9f9ec5..5c46afd 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -1924,7 +1924,7 @@ ParseLexeme( unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ Tcl_Obj **literalPtr) /* Write corresponding literal value to this - storage, if non-NULL. */ + * storage, if non-NULL. */ { const char *end; int ch; diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 7a8783c..5a64ff8 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -45,21 +45,20 @@ static const Tcl_ObjType instNameType = { TCL_OBJTYPE_V0 }; -#define InstNameSetInternalRep(objPtr, inst) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.wideValue = (inst); \ +#define InstNameSetInternalRep(objPtr, inst) \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.wideValue = (inst); \ Tcl_StoreInternalRep((objPtr), &instNameType, &ir); \ } while (0) -#define InstNameGetInternalRep(objPtr, inst) \ - do { \ +#define InstNameGetInternalRep(objPtr, inst) \ + do { \ const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &instNameType); \ - assert(irPtr != NULL); \ - (inst) = irPtr->wideValue; \ + irPtr = TclFetchInternalRep((objPtr), &instNameType); \ + assert(irPtr != NULL); \ + (inst) = irPtr->wideValue; \ } while (0) - /* *---------------------------------------------------------------------- diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 4b1ef16..0844303 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -258,7 +258,6 @@ static Tcl_EncodingConvertProc UtfToUtfProc; static Tcl_EncodingConvertProc Iso88591FromUtfProc; static Tcl_EncodingConvertProc Iso88591ToUtfProc; - /* * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field * of the internalrep. This should help the lifetime of encodings be more useful. @@ -274,21 +273,20 @@ static const Tcl_ObjType encodingType = { TCL_OBJTYPE_V0 }; -#define EncodingSetInternalRep(objPtr, encoding) \ +#define EncodingSetInternalRep(objPtr, encoding) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (encoding); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \ + Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \ } while (0) -#define EncodingGetInternalRep(objPtr, encoding) \ +#define EncodingGetInternalRep(objPtr, encoding) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep ((objPtr), &encodingType); \ - (encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \ + (encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) - /* *---------------------------------------------------------------------- @@ -1112,7 +1110,6 @@ Tcl_ExternalToUtfDString( NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL); return Tcl_DStringValue(dstPtr); } - /* *------------------------------------------------------------------------- @@ -1158,14 +1155,14 @@ Tcl_ExternalToUtfDStringEx( Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - Tcl_Size srcLen, /* Source string length in bytes, or < 0 for + Tcl_Size srcLen, /* Source string length in bytes, or < 0 for * encoding-specific string length. */ int flags, /* Conversion control flags. */ Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ Tcl_Size *errorLocPtr) /* Where to store the error location - (or TCL_INDEX_NONE if no error). May - be NULL. */ + * (or TCL_INDEX_NONE if no error). May + * be NULL. */ { char *dst; Tcl_EncodingState state; @@ -1430,7 +1427,6 @@ Tcl_UtfToExternalDString( NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL); return Tcl_DStringValue(dstPtr); } - /* *------------------------------------------------------------------------- @@ -1481,8 +1477,8 @@ Tcl_UtfToExternalDStringEx( Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ Tcl_Size *errorLocPtr) /* Where to store the error location - (or TCL_INDEX_NONE if no error). May - be NULL. */ + * (or TCL_INDEX_NONE if no error). May + * be NULL. */ { char *dst; Tcl_EncodingState state; diff --git a/generic/tclEnv.c b/generic/tclEnv.c index ef4e946..0128672 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -20,9 +20,9 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #if defined(_WIN32) # define tenviron _wenviron # define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ - (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr))) + (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr))) # define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ - (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr))) + (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr))) # define techar WCHAR # ifdef USE_PUTENV # define putenv(env) _wputenv((const wchar_t *)env) @@ -30,13 +30,12 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #else # define tenviron environ # define tenviron2utfdstr(str, dsPtr) \ - Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr) + Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr) # define utf2tenvirondstr(str, dsPtr) \ - Tcl_UtfToExternalDString(NULL, str, -1, dsPtr) + Tcl_UtfToExternalDString(NULL, str, -1, dsPtr) # define techar char #endif - /* MODULE_SCOPE */ size_t TclEnvEpoch = 0; /* Epoch of the tcl environment * (if changed with tcl-env). */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 334cfae..29d8a0c 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -893,7 +893,6 @@ Tcl_SetExitProc( return prevExitProc; } - /* *---------------------------------------------------------------------- @@ -935,7 +934,6 @@ InvokeExitHandlers(void) firstExitPtr = NULL; Tcl_MutexUnlock(&exitMutex); } - /* *---------------------------------------------------------------------- diff --git a/generic/tclExecute.c b/generic/tclExecute.c index da08f3a..c94e570 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1024,7 +1024,6 @@ GrowEvaluationStack( } needed = growth + moveWords + WALLOCALIGN; - /* * Check if there is enough room in the next stack (if there is one, it * should be both empty and the last one!) @@ -6604,7 +6603,6 @@ TEBCresume( } CACHE_STACK_INFO(); - valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { if (valIndex >= listLen) { diff --git a/generic/tclHash.c b/generic/tclHash.c index 5be07cb..89807e2 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -214,7 +214,6 @@ FindHashEntry( { return CreateHashEntry(tablePtr, key, NULL); } - /* *---------------------------------------------------------------------- @@ -301,8 +300,7 @@ CreateHashEntry( } /* if needle pointer equals content pointer or values equal */ if ((key == hPtr->key.string) - || compareKeysProc((void *) key, hPtr) - ) { + || compareKeysProc((void *) key, hPtr)) { if (newPtr) { *newPtr = 0; } diff --git a/generic/tclIO.c b/generic/tclIO.c index 78cda5c..eec6062 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8711,9 +8711,8 @@ UpdateInterest( && (mask & TCL_WRITABLE) && GotFlag(statePtr, CHANNEL_NONBLOCKING) && bufPtr - && !IsBufferEmpty(bufPtr) - && !IsBufferFull(bufPtr) - ) { + && !IsBufferEmpty(bufPtr) + && !IsBufferFull(bufPtr)) { TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, @@ -8798,8 +8797,7 @@ ChannelTimerProc( static void DeleteTimerHandler( - ChannelState *statePtr -) + ChannelState *statePtr) { if (statePtr->timer != NULL) { Tcl_DeleteTimerHandler(statePtr->timer); @@ -8808,8 +8806,8 @@ DeleteTimerHandler( } static void CleanupTimerHandler( - ChannelState *statePtr -){ + ChannelState *statePtr) +{ TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); statePtr->timer = NULL; statePtr->timerChanPtr = NULL; @@ -10297,20 +10295,13 @@ Lossless( return inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF && outStatePtr->outputTranslation == TCL_TRANSLATE_LF - && ( - ( - inStatePtr->encoding == GetBinaryEncoding() - && - outStatePtr->encoding == GetBinaryEncoding() - ) - || - ( - toRead == -1 + && ((inStatePtr->encoding == GetBinaryEncoding() + && outStatePtr->encoding == GetBinaryEncoding()) + || (toRead == -1 && inStatePtr->encoding == outStatePtr->encoding && ENCODING_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 && ENCODING_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 - ) - ); + )); } /* diff --git a/generic/tclIO.h b/generic/tclIO.h index 08fff44..8823e06 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -191,8 +191,8 @@ typedef struct ChannelState { Tcl_Size bufSize; /* What size buffers to allocate? */ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ Channel *timerChanPtr; /* Needed in order to decrement the refCount of - the right channel when the timer is - deleted. */ + * the right channel when the timer is + * deleted. */ struct CopyState *csPtrR; /* State of background copy for which channel * is input, or NULL. */ struct CopyState *csPtrW; /* State of background copy for which channel diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index cb90059..fc4ddb6 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -606,7 +606,6 @@ Tcl_TellObjCmd( * them into the regular interpreter result. */ - code = TclChanCaughtErrorBypass(interp, chan); TclChannelRelease(chan); if (code) { diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index fe54f65..0118ce0 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -62,27 +62,27 @@ static void TimerRunWrite(void *clientData); */ static const Tcl_ChannelType tclRChannelType = { - "tclrchannel", /* Type name. */ + "tclrchannel", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close channel, clean instance data */ - ReflectInput, /* Handle read request */ - ReflectOutput, /* Handle write request */ + NULL, /* Old close API */ + ReflectInput, /* Handle read request */ + ReflectOutput, /* Handle write request */ NULL, - ReflectSetOption, /* Set options. NULL'able */ - ReflectGetOption, /* Get options. NULL'able */ - ReflectWatch, /* Initialize notifier */ - NULL, /* Get OS handle from the channel. NULL'able */ - ReflectClose, /* No close2 support. NULL'able */ - ReflectBlock, /* Set blocking/nonblocking. NULL'able */ - NULL, /* Flush channel. Not used by core. NULL'able */ - NULL, /* Handle events. NULL'able */ - ReflectSeekWide, /* Move access point (64 bit). NULL'able */ + ReflectSetOption, /* Set options. */ + ReflectGetOption, /* Get options. */ + ReflectWatch, /* Initialize notifier */ + NULL, /* Get OS handle from the channel. */ + ReflectClose, /* Close channel. Clean instance data */ + ReflectBlock, /* Set blocking/nonblocking. */ + NULL, /* Flush channel. */ + NULL, /* Handle events. */ + ReflectSeekWide, /* Move access point (64 bit). */ #if TCL_THREADS - ReflectThread, /* thread action, tracking owner */ + ReflectThread, /* thread action, tracking owner */ #else - NULL, /* thread action */ + NULL, /* thread action */ #endif - ReflectTruncate /* Truncate. NULL'able */ + ReflectTruncate /* Truncate. */ }; /* @@ -96,11 +96,10 @@ typedef struct { * Tcl level part of the channel. NULL here * signals the channel is dead because the * interpreter/thread containing its Tcl - * command is gone. - */ + * command is gone. */ #if TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ - Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ + Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif Tcl_Obj *cmd; /* Callback command prefix */ Tcl_Obj *methods; /* Methods to append to command prefix */ @@ -113,16 +112,12 @@ typedef struct { int dead; /* Boolean signal that some operations * should no longer be attempted. */ - Tcl_TimerToken readTimer; /* - A token for the timer that is scheduled in - order to call Tcl_NotifyChannel when the - channel is readable - */ - Tcl_TimerToken writeTimer; /* - A token for the timer that is scheduled in - order to call Tcl_NotifyChannel when the - channel is writable - */ + Tcl_TimerToken readTimer; /* A token for the timer that is scheduled in + * order to call Tcl_NotifyChannel when the + * channel is readable */ + Tcl_TimerToken writeTimer; /* A token for the timer that is scheduled in + * order to call Tcl_NotifyChannel when the + * channel is writable */ /* * Note regarding the usage of timers. @@ -266,7 +261,7 @@ typedef struct { struct ForwardParamInput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* O: Where to store the read bytes */ - Tcl_Size toRead; /* I: #bytes to read, + Tcl_Size toRead; /* I: #bytes to read, * O: #bytes actually read */ }; struct ForwardParamOutput { @@ -513,7 +508,7 @@ TclChanCreateObjCmd( Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Channel chan; /* Token for the new channel */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - Tcl_Size listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index c1e5c31..2ad6ecf0 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -58,18 +58,17 @@ static int ReflectNotify(void *clientData, int mask); static const Tcl_ChannelType tclRTransformType = { "tclrtransform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel. */ - NULL, /* Close channel, clean instance data. */ + NULL, ReflectInput, /* Handle read request. */ ReflectOutput, /* Handle write request. */ - NULL, /* Move location of access point. */ + NULL, /* Move location of access point. */ ReflectSetOption, /* Set options. */ ReflectGetOption, /* Get options. */ ReflectWatch, /* Initialize notifier. */ ReflectHandle, /* Get OS handle from the channel. */ - ReflectClose, /* No close2 support. NULL'able. */ + ReflectClose, /* Close channel, clean instance data. */ ReflectBlock, /* Set blocking/nonblocking. */ - NULL, /* Flush channel. Not used by core. - * NULL'able. */ + NULL, /* Flush channel. Not used by core. */ ReflectNotify, /* Handle events. */ ReflectSeekWide, /* Move access point (64 bit). */ NULL, /* thread action */ @@ -511,7 +510,7 @@ TclChanPushObjCmd( Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Obj *rtId; /* Handle of the new transform (channel) */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - Tcl_Size listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ @@ -1105,7 +1104,6 @@ ReflectInput( goto stop; } - /* * The buffer is exhausted, but the caller wants even more. We now * have to go to the underlying channel, get more bytes and then @@ -1141,7 +1139,6 @@ ReflectInput( goto stop; } - readBytes = Tcl_ReadRaw(rtPtr->parent, (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead); if (readBytes < 0) { @@ -1492,7 +1489,7 @@ ReflectBlock( static int ReflectSetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ const char *newValue) /* The new value */ @@ -1534,7 +1531,7 @@ ReflectSetOption( static int ReflectGetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ Tcl_DString *dsPtr) /* String to place the result into */ @@ -1645,7 +1642,6 @@ ReflectNotify( /* * Helpers. ========================================================= */ - /* *---------------------------------------------------------------------- @@ -2075,7 +2071,8 @@ static ReflectedTransformMap * GetReflectedTransformMap( Tcl_Interp *interp) { - ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL); + ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *) + Tcl_GetAssocData(interp, RTMKEY, NULL); if (rtmPtr == NULL) { rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap)); @@ -2108,7 +2105,7 @@ GetReflectedTransformMap( static void DeleteReflectedTransformMap( - void *clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedTransformMap *rtmPtr; /* The map */ @@ -2243,7 +2240,8 @@ GetThreadReflectedTransformMap(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rtmPtr) { - tsdPtr->rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap)); + tsdPtr->rtmPtr = (ReflectedTransformMap *) + Tcl_Alloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL); } @@ -2993,7 +2991,7 @@ static inline size_t ResultCopy( ResultBuffer *rPtr, /* The buffer to read from */ unsigned char *buf, /* The buffer to copy into */ - size_t toRead) /* Number of requested bytes */ + size_t toRead) /* Number of requested bytes */ { int copied; diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 47fde36..81526fa 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -18,7 +18,7 @@ typedef struct { int initialized; - Tcl_DString errorMsg; /* UTF-8 encoded error-message */ + Tcl_DString errorMsg; /* UTF-8 encoded error-message */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -75,7 +75,8 @@ TclSockGetPort( * Don't bother translating 'proto' to native. */ - if (Tcl_UtfToExternalDStringEx(interp, NULL, string, -1, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, string, -1, 0, &ds, + NULL) != TCL_OK) { Tcl_DStringFree(&ds); return TCL_ERROR; } @@ -188,7 +189,8 @@ TclCreateSocketAddress( int result; if (host != NULL) { - if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, + NULL) != TCL_OK) { Tcl_DStringFree(&ds); return 0; } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 6067282..c3131cd 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -35,7 +35,7 @@ */ typedef struct FilesystemRecord { - void *clientData; /* Client-specific data for the filesystem + void *clientData; /* Client-specific data for the filesystem * (can be NULL) */ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */ struct FilesystemRecord *nextPtr; @@ -52,13 +52,11 @@ typedef struct FilesystemRecord { typedef struct { int initialized; size_t cwdPathEpoch; /* Compared with the global cwdPathEpoch to - * determine whether cwdPathPtr is stale. - */ + * determine whether cwdPathPtr is stale. */ size_t filesystemEpoch; Tcl_Obj *cwdPathPtr; /* A private copy of cwdPathPtr. Updated when * the value is accessed and cwdPathEpoch has - * changed. - */ + * changed. */ void *cwdClientData; FilesystemRecord *filesystemList; size_t claims; @@ -106,7 +104,6 @@ static Tcl_FSFileAttrsSetProc NativeFileAttrsSet; MODULE_SCOPE const char *const tclpFileAttrStrings[]; MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; - /* * These these functions are not static either because routines in the native * (win/unix) directories call them or they are actually implemented in those @@ -242,7 +239,8 @@ typedef struct { /* Obsolete */ int Tcl_Stat( - const char *path, /* Pathname of file to stat (in current CP). */ + const char *path, /* Pathname of file to stat (in current system + * encoding). */ struct stat *oldStyleBuf) /* Filled with results of stat call. */ { int ret; @@ -329,8 +327,8 @@ Tcl_Stat( /* Obsolete */ int Tcl_Access( - const char *path, /* Pathname of file to access (in current CP). - */ + const char *path, /* Pathname of file to access (in current + * system encoding). */ int mode) /* Permission setting. */ { int ret; @@ -845,7 +843,7 @@ TclResetFilesystem(void) int Tcl_FSRegister( - void *clientData, /* Client-specific data for this filesystem. */ + void *clientData, /* Client-specific data for this filesystem. */ const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */ { FilesystemRecord *newFilesystemPtr; @@ -1105,8 +1103,7 @@ FsAddMountsToGlobResult( Tcl_Obj *pathPtr, /* The directory that was searched. */ const char *pattern, /* Pattern to match mounts against. */ Tcl_GlobTypeData *types) /* Acceptable types. May be NULL. The - * directory flag is particularly significant. - */ + * directory flag is particularly significant. */ { Tcl_Size mLength, gLength, i; int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR)); @@ -1171,7 +1168,6 @@ FsAddMountsToGlobResult( } len++; /* account for '/' in the mElt [Bug 1602539] */ - mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len); Tcl_ListObjAppendElement(NULL, resultPtr, mElt); } @@ -1365,7 +1361,6 @@ TclFSNormalizeToUniquePath( Claim(); if (!isVfsPath) { - /* * Find and call the native filesystem handler first if there is one * because the root of Tcl's filesystem is always a native filesystem @@ -1693,7 +1688,7 @@ Tcl_FSEvalFileEx( * Tilde-substitution is performed on this * pathname. */ const char *encodingName) /* Either the name of an encoding or NULL to - use the utf-8 encoding. */ + * use the utf-8 encoding. */ { Tcl_Size length; int result = TCL_ERROR; @@ -2086,7 +2081,7 @@ Tcl_PosixError( int Tcl_FSStat( Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in - * current CP). */ + * current system encoding). */ Tcl_StatBuf *buf) /* A buffer to hold the results of the call to * stat. */ { @@ -2121,7 +2116,7 @@ Tcl_FSStat( int Tcl_FSLstat( Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in - current CP). */ + * current system encoding). */ Tcl_StatBuf *buf) /* Filled with results of that call to stat. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -2158,7 +2153,8 @@ Tcl_FSLstat( int Tcl_FSAccess( - Tcl_Obj *pathPtr, /* Pathname of file to access (in current CP). */ + Tcl_Obj *pathPtr, /* Pathname of file to access (in current + * system encoding). */ int mode) /* Permission setting. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -2195,12 +2191,11 @@ Tcl_FSOpenFileChannel( const char *modeString, /* A list of POSIX open modes or a string such * as "rw". */ int permissions) /* What modes to use if opening the file - involves creating it. */ + * involves creating it. */ { const Tcl_Filesystem *fsPtr; Tcl_Channel retVal = NULL; - if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { /* * Return the correct error message. @@ -3020,8 +3015,8 @@ Tcl_FSChdir( int Tcl_FSLoadFile( Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic shared object. - */ + Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic + * shared object. */ const char *sym1, const char *sym2, /* Names of two functions to find in the * dynamic shared object. */ @@ -3109,14 +3104,13 @@ skipUnlink( * * 1. The operating system is HPUX. * - * 2. If the environment variable TCL_TEMPLOAD_NO_UNLINK is present and - * set to true (an integer > 0) - * - * 3. TCL_TEMPLOAD_NO_UNLINK is not true (an integer > 0) and AUFS filesystem can be detected (using statfs, if available). + * 2. If the environment variable TCL_TEMPLOAD_NO_UNLINK is present and + * set to true (an integer > 0) * + * 3. TCL_TEMPLOAD_NO_UNLINK is not true (an integer > 0) and AUFS + * filesystem can be detected (using statfs, if available). */ - #ifdef hpux (void)shlibFile; return 1; @@ -3655,9 +3649,7 @@ Tcl_FSUnloadFile( Tcl_Obj * Tcl_FSLink( Tcl_Obj *pathPtr, /* Pathaname of file. */ - Tcl_Obj *toPtr, /* - * NULL or the pathname of a file to link to. - */ + Tcl_Obj *toPtr, /* NULL or the pathname of a file to link to. */ int linkAction) /* Action to perform. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -3906,7 +3898,8 @@ TclGetPathType( /* If not NULL, a place in which to store a * pointer to the filesystem for this pathname * if it is absolute. */ - Tcl_Size *driveNameLengthPtr, /* If not NULL, a place in which to store the + Tcl_Size *driveNameLengthPtr, + /* If not NULL, a place in which to store the * length of the volume name. */ Tcl_Obj **driveNameRef) /* If not NULL, for an absolute pathname, a * place to store a pointer to an object with a @@ -3960,9 +3953,9 @@ TclFSNonnativePathType( /* If not NULL, a place to store a pointer to * the filesystem for this pathname when it is * an absolute pathname. */ - Tcl_Size *driveNameLengthPtr,/* If not NULL, a place to store the length of - * the volume name if the pathname is absolute. - */ + Tcl_Size *driveNameLengthPtr, + /* If not NULL, a place to store the length of + * the volume name if the pathname is absolute. */ Tcl_Obj **driveNameRef) /* If not NULL, a place to store a pointer to * an object having its its refCount already * incremented, and contining the name of the @@ -4078,7 +4071,7 @@ TclFSNonnativePathType( int Tcl_FSRenameFile( Tcl_Obj *srcPathPtr, /* The pathname of a file or directory to be - renamed. */ + * renamed. */ Tcl_Obj *destPathPtr) /* The new pathname for the file. */ { int retVal = -1; diff --git a/generic/tclInt.h b/generic/tclInt.h index d6fdb88..768143c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1108,7 +1108,6 @@ typedef struct ActiveInterpTrace { ((objPtr)->typePtr)->proc : NULL) MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *); - /* * Abstract List diff --git a/generic/tclInterp.c b/generic/tclInterp.c index b2d883b..5fbefbf 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -186,7 +186,7 @@ struct LimitHandler { int flags; /* The state of this particular handler. */ Tcl_LimitHandlerProc *handlerProc; /* The handler callback. */ - void *clientData; /* Opaque argument to the handler callback. */ + void *clientData; /* Opaque argument to the handler callback. */ Tcl_LimitHandlerDeleteProc *deleteProc; /* How to delete the clientData. */ LimitHandler *prevPtr; /* Previous item in linked list of @@ -207,8 +207,6 @@ struct LimitHandler { #define LIMIT_HANDLER_ACTIVE 0x01 #define LIMIT_HANDLER_DELETED 0x02 - - /* * Prototypes for local static functions: */ @@ -277,7 +275,6 @@ static void TimeLimitCallback(void *clientData); static Tcl_NRPostProc NRPostInvokeHidden; static Tcl_ObjCmdProc NRInterpCmd; static Tcl_ObjCmdProc NRChildCmd; - /* *---------------------------------------------------------------------- diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 2d925e7..1bb3587 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1616,8 +1616,7 @@ Tcl_Obj * TclListObjGetElement( Tcl_Obj *objPtr, /* List object for which an element array is * to be returned. */ - Tcl_Size index -) + Tcl_Size index) { return ListObjStorePtr(objPtr)->slots[ListObjStart(objPtr) + index]; } @@ -2018,7 +2017,6 @@ Tcl_ListObjLength( return TCL_OK; } - if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { return TCL_ERROR; } @@ -3552,7 +3550,6 @@ UpdateStringOfList( Tcl_Free(flagPtr); } } - /* *------------------------------------------------------------------------ diff --git a/generic/tclLoad.c b/generic/tclLoad.c index d7c13d1..c5a181d 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -12,7 +12,6 @@ #include "tclInt.h" - /* * The following structure describes a library that has been loaded either * dynamically (with the "load" command) or statically (as indicated by a call @@ -96,7 +95,6 @@ static int IsStatic(LoadedLibrary *libraryPtr); static int UnloadLibrary(Tcl_Interp *interp, Tcl_Interp *target, LoadedLibrary *library, int keepLibrary, const char *fullFileName, int interpExiting); - static int IsStatic( @@ -144,7 +142,7 @@ Tcl_LoadObjCmd( int flags = 0; Tcl_Obj *const *savedobjv = objv; static const char *const options[] = { - "-global", "-lazy", "--", NULL + "-global", "-lazy", "--", NULL }; enum loadOptionsEnum { LOAD_GLOBAL, LOAD_LAZY, LOAD_LAST @@ -168,7 +166,8 @@ Tcl_LoadObjCmd( } } if ((objc < 2) || (objc > 4)) { - Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"); + Tcl_WrongNumArgs(interp, 1, savedobjv, + "?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { @@ -753,7 +752,6 @@ Tcl_UnloadObjCmd( } return code; } - /* *---------------------------------------------------------------------- @@ -773,13 +771,12 @@ Tcl_UnloadObjCmd( */ static int UnloadLibrary( - Tcl_Interp *interp, - Tcl_Interp *target, - LoadedLibrary *libraryPtr, - int keepLibrary, - const char *fullFileName, - int interpExiting -) + Tcl_Interp *interp, + Tcl_Interp *target, + LoadedLibrary *libraryPtr, + int keepLibrary, + const char *fullFileName, + int interpExiting) { int code; InterpLibrary *ipFirstPtr, *ipPtr; @@ -821,8 +818,6 @@ UnloadLibrary( unloadProc = libraryPtr->unloadProc; } - - /* * We are ready to unload the library. First, evaluate the unload * function. If this fails, we cannot proceed with unload. Also, we must @@ -856,13 +851,11 @@ UnloadLibrary( code = unloadProc(target, code); } - if (code != TCL_OK) { Tcl_TransferResult(target, code, interp); goto done; } - /* * Remove this library from the interpreter's library cache. */ @@ -885,7 +878,6 @@ UnloadLibrary( Tcl_Free(ipPtr); Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); - if (IsStatic(libraryPtr)) { goto done; } @@ -1107,9 +1099,8 @@ TclGetLoadedLibraries( * NULL, return info about all interps; * otherwise, just return info about this * interpreter. */ - const char *prefix) /* Prefix or NULL. If NULL, return info - * for all prefixes. - */ + const char *prefix) /* Prefix or NULL. If NULL, return info + * for all prefixes. */ { Tcl_Interp *target; LoadedLibrary *libraryPtr; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 2a30742..eebf6aa 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -1079,8 +1079,7 @@ TclNamespaceDeleted( void TclDeleteNamespaceChildren( - Namespace *nsPtr /* Namespace whose children to delete */ -) + Namespace *nsPtr) /* Namespace whose children to delete */ { Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; @@ -3962,7 +3961,6 @@ NamespaceOriginCmd( Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } - /* *---------------------------------------------------------------------- @@ -5156,7 +5154,6 @@ Tcl_LogCommandInfo( { TclLogCommandInfo(interp, script, command, length, NULL, NULL); } - /* * Local Variables: diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 7695483..46ee8be 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -155,7 +155,6 @@ static const Tcl_ObjType methodNameType = { NULL, TCL_OBJTYPE_V0 }; - /* * ---------------------------------------------------------------------- diff --git a/generic/tclObj.c b/generic/tclObj.c index 30634a0..36856d4 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -349,7 +349,6 @@ typedef struct ResolvedCmdName { #define FREEDREFCOUNTFILLER \ (Tcl_Size)(sizeof(objPtr->refCount) == 4 ? 0xe8e8e8e8 : 0xe8e8e8e8e8e8e8e8) #endif - /* *------------------------------------------------------------------------- @@ -2568,7 +2567,6 @@ Tcl_GetIntFromObj( return TCL_OK; #endif } - /* *---------------------------------------------------------------------- diff --git a/generic/tclPanic.c b/generic/tclPanic.c index dcceb25..ed12640 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -81,7 +81,6 @@ Tcl_Panic( * to pass to fprintf. */ char *arg4, *arg5, *arg6, *arg7, *arg8; - va_start(argList, format); arg1 = va_arg(argList, char *); arg2 = va_arg(argList, char *); diff --git a/generic/tclParse.c b/generic/tclParse.c index 13e5c1e..e88de0b 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -1396,7 +1396,7 @@ Tcl_ParseVarName( case '}': braceCount--; break; case '\\': /* if 2 or more left, consume 2, else consume - just the \ and let it run into the end */ + * just the \ and let it run into the end */ if (numBytes > 1) { src++; numBytes--; } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 80954bc..9a44863 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -1519,7 +1519,6 @@ Tcl_FSNewNativePath( Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; - if (fromFilesystem->internalToNormalizedProc != NULL) { pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); } @@ -2689,7 +2688,6 @@ TclResolveTildePathList( return resolvedPaths; } - /* * Local Variables: diff --git a/generic/tclProc.c b/generic/tclProc.c index 40c6f32..2f87048 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -69,7 +69,7 @@ const Tcl_ObjType tclProcBodyType = { TCL_OBJTYPE_V0 }; -#define ProcSetInternalRep(objPtr, procPtr) \ +#define ProcSetInternalRep(objPtr, procPtr) \ do { \ Tcl_ObjInternalRep ir; \ (procPtr)->refCount++; \ @@ -78,11 +78,11 @@ const Tcl_ObjType tclProcBodyType = { Tcl_StoreInternalRep((objPtr), &tclProcBodyType, &ir); \ } while (0) -#define ProcGetInternalRep(objPtr, procPtr) \ +#define ProcGetInternalRep(objPtr, procPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \ - (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -116,23 +116,22 @@ static const Tcl_ObjType lambdaType = { TCL_OBJTYPE_V0 }; -#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \ +#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (procPtr); \ ir.twoPtrValue.ptr2 = (nsObjPtr); \ Tcl_IncrRefCount((nsObjPtr)); \ - Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \ + Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \ } while (0) -#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \ +#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &lambdaType); \ - (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ - (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &lambdaType); \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ + (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) - /* *---------------------------------------------------------------------- @@ -156,7 +155,7 @@ int Tcl_ProcObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -1095,7 +1094,8 @@ ProcWrongNumArgs( if (defPtr->value.objPtr != NULL) { TclNewObj(argObj); - Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", (void *)NULL); + Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", + (void *)NULL); } else if (defPtr->flags & VAR_IS_ARGS) { numArgs--; final = "?arg ...?"; @@ -1339,7 +1339,7 @@ InitLocalCache( static int InitArgsAndLocals( - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ int skip) /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ @@ -1503,9 +1503,9 @@ InitArgsAndLocals( int TclPushProcCallFrame( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ Tcl_Size objc, /* Count of number of arguments to this * procedure. */ @@ -1597,9 +1597,9 @@ TclPushProcCallFrame( int TclObjInterpProc( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ @@ -1614,11 +1614,11 @@ TclObjInterpProc( int TclNRInterpProc( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ - Tcl_Size objc, /* Count of number of arguments to this + Tcl_Size objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1637,7 +1637,7 @@ NRInterpProc( * interpreted. */ Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ - int objc, /* Count of number of arguments to this + int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1666,7 +1666,6 @@ ObjInterpProc2( return Tcl_NRCallObjProc2(interp, TclNRInterpProc, clientData, objc, objv); } - /* *---------------------------------------------------------------------- @@ -1688,10 +1687,10 @@ ObjInterpProc2( int TclNRInterpProcCore( - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ - Tcl_Size skip, /* Number of initial arguments to be skipped, + Tcl_Size skip, /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ ProcErrorProc *errorProc) /* How to convert results from the script into * results of the overall procedure. */ @@ -2137,7 +2136,7 @@ TclProcDeleteProc( void TclProcCleanupProc( - Proc *procPtr) /* Procedure to be deleted. */ + Proc *procPtr) /* Procedure to be deleted. */ { CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; @@ -2402,7 +2401,7 @@ ProcBodyFree( static void DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; @@ -2417,7 +2416,7 @@ DupLambdaInternalRep( static void FreeLambdaInternalRep( - Tcl_Obj *objPtr) /* CmdName object with internal representation + Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { Proc *procPtr; @@ -2435,7 +2434,7 @@ FreeLambdaInternalRep( static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 968e191..a5607d9 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -350,7 +350,6 @@ WaitProcessStatus( } } - /* *---------------------------------------------------------------------- * @@ -891,8 +890,7 @@ TclProcessWait( * - errno in case of error. * - non-zero exit code for abormal exit. * - signal number if killed or suspended. - * - Tcl_WaitPid status in all other cases. - */ + * - Tcl_WaitPid status in all other cases. */ Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */ Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */ { diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index bc6468d..04f060b 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -111,22 +111,21 @@ const Tcl_ObjType tclRegexpType = { TCL_OBJTYPE_V0 }; -#define RegexpSetInternalRep(objPtr, rePtr) \ +#define RegexpSetInternalRep(objPtr, rePtr) \ do { \ Tcl_ObjInternalRep ir; \ (rePtr)->refCount++; \ ir.twoPtrValue.ptr1 = (rePtr); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &tclRegexpType, &ir); \ + Tcl_StoreInternalRep((objPtr), &tclRegexpType, &ir); \ } while (0) -#define RegexpGetInternalRep(objPtr, rePtr) \ +#define RegexpGetInternalRep(objPtr, rePtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &tclRegexpType); \ - (rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \ + (rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) - /* *---------------------------------------------------------------------- @@ -223,8 +222,8 @@ Tcl_RegExpExec( Tcl_DStringInit(&ds); ustr = Tcl_UtfToUniCharDString(text, TCL_INDEX_NONE, &ds); numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar); - result = RegExpExecUniChar(interp, re, ustr, numChars, TCL_INDEX_NONE /* nmatches */, - flags); + result = RegExpExecUniChar(interp, re, ustr, numChars, + TCL_INDEX_NONE /* nmatches */, flags); Tcl_DStringFree(&ds); return result; @@ -306,7 +305,7 @@ RegExpExecUniChar( * previous call to Tcl_GetRegExpFromObj */ const Tcl_UniChar *wString, /* String against which to match re. */ size_t numChars, /* Length of Tcl_UniChar string. */ - size_t nm, /* How many subexpression matches (counting + size_t nm, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means "don't know". */ int flags) /* Regular expression flags. */ @@ -367,9 +366,9 @@ TclRegExpRangeUniChar( * > 0 means give the range of a matching * subrange, -1 means the range of the * rm_extend field. */ - Tcl_Size *startPtr, /* Store address of first character in + Tcl_Size *startPtr, /* Store address of first character in * (sub-)range here. */ - Tcl_Size *endPtr) /* Store address of character just after last + Tcl_Size *endPtr) /* Store address of character just after last * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; @@ -445,7 +444,7 @@ Tcl_RegExpExecObj( Tcl_Obj *textObj, /* Text against which to match re. */ Tcl_Size offset, /* Character index that marks where matching * should begin. */ - Tcl_Size nmatches, /* How many subexpression matches (counting + Tcl_Size nmatches, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means all of them. */ int flags) /* Regular expression execution flags. */ @@ -859,7 +858,7 @@ static TclRegexp * CompileRegexp( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ const char *string, /* The regexp to compile (UTF-8). */ - size_t length, /* The length of the string in bytes. */ + size_t length, /* The length of the string in bytes. */ int flags) /* Compilation flags. */ { TclRegexp *regexpPtr; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 87aab60..1b78184 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -26,7 +26,6 @@ # define PRIx64 TCL_LL_MODIFIER "x" #endif - /* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be @@ -4230,7 +4229,6 @@ StrictBignumConversion( * Extract the next group of digits. */ - if ((err != MP_OKAY) || (mp_div(&b, &S, &dig, &b) != MP_OKAY) || (dig.used > 1)) { Tcl_Panic("wrong digit!"); } @@ -4848,7 +4846,6 @@ TclBignumToDouble( mp_err err; const mp_int *a = (const mp_int *)big; - /* * We need a 'mantBits'-bit significand. Determine what shift will * give us that. diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 73391fe..05c578e 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -459,7 +459,6 @@ TclGetCharLength( return numChars; } - /* *---------------------------------------------------------------------- * @@ -3520,7 +3519,6 @@ TclStringCat( *--------------------------------------------------------------------------- */ - static int UniCharNcasememcmp( const void *ucsPtr, /* Unicode string to compare to uct. */ diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index 4e38a64..a7bca14 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -18,7 +18,6 @@ #ifndef _TCLSTRINGREP #define _TCLSTRINGREP - /* * The following structure is the internal rep for a String object. It keeps * track of how much memory has been used and how much has been allocated for diff --git a/generic/tclStubLibTbl.c b/generic/tclStubLibTbl.c index ad34494..6ac879c 100644 --- a/generic/tclStubLibTbl.c +++ b/generic/tclStubLibTbl.c @@ -33,14 +33,14 @@ MODULE_SCOPE void *tclStubsHandle; */ MODULE_SCOPE const char * TclInitStubTable( - const char *version) /* points to the version field of a - structure variable. */ + const char *version) /* points to the version field of a + * structure variable. */ { if (version) { if (tclStubsHandle == NULL) { - /* This can only happen with -DBUILD_STATIC, so simulate - * that the loading of Tcl succeeded, although we didn't - * actually load it dynamically */ + /* This can only happen with -DBUILD_STATIC, so simulate + * that the loading of Tcl succeeded, although we didn't + * actually load it dynamically */ tclStubsHandle = (void *)1; } tclStubsPtr = ((const TclStubs **) version)[-1]; diff --git a/generic/tclThread.c b/generic/tclThread.c index 698c642..c107780 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -145,7 +145,6 @@ RememberSyncObject( void **newList; int i, j; - /* * Reuse any free slot in the list. */ diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c index c0786c9..492c95f 100644 --- a/generic/tclTomMathStubLib.c +++ b/generic/tclTomMathStubLib.c @@ -18,7 +18,6 @@ MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr; const TclTomMathStubs *tclTomMathStubsPtr = NULL; - /* *---------------------------------------------------------------------- * diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 33085f3..f4e9fe5 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1016,7 +1016,6 @@ Tcl_TraceCommand( cmdPtr->flags |= CMD_HAS_EXEC_TRACES; } - return TCL_OK; } diff --git a/generic/tclUtf.c b/generic/tclUtf.c index e107081..03ea8b6 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1717,7 +1717,6 @@ TclUtfCmp( } return UCHAR(*cs) - UCHAR(*ct); } - /* *---------------------------------------------------------------------- @@ -1757,7 +1756,6 @@ TclUtfCasecmp( } return UCHAR(*cs) - UCHAR(*ct); } - /* *---------------------------------------------------------------------- diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0c9a3b2..3043fed 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2598,10 +2598,11 @@ char * Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *bytes, /* String to append. If length is - * TCL_INDEX_NONE then this must be null-terminated. */ + * TCL_INDEX_NONE then this must be + * null-terminated. */ Tcl_Size length) /* Number of bytes from "bytes" to append. If - * TCL_INDEX_NONE, then append all of bytes, up to null - * at end. */ + * TCL_INDEX_NONE, then append all of bytes, up + * to null at end. */ { Tcl_Size newSize; @@ -2617,7 +2618,6 @@ Tcl_DStringAppend( } newSize = length + dsPtr->length + 1; - if (newSize > dsPtr->spaceAvl) { if (dsPtr->string == dsPtr->staticSpace) { char *newString; diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 12f0ea0..b0bb383 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -217,9 +217,9 @@ typedef struct ZipEntry { ZipFile *zipFilePtr; /* The ZIP file holding this virtual file */ size_t offset; /* Data offset into memory mapped ZIP file */ int numBytes; /* Uncompressed size of the virtual file. - -1 for zip64 */ + * -1 for zip64 */ int numCompressedBytes; /* Compressed size of the virtual file. - -1 for zip64 */ + * -1 for zip64 */ int compressMethod; /* Compress method */ int isDirectory; /* 0 if file, 1 if directory, -1 if root */ int depth; /* Number of slashes in path. */ @@ -810,11 +810,13 @@ IsCryptHeaderValid( *------------------------------------------------------------------------ */ static int -DecodeCryptHeader(Tcl_Interp *interp, - ZipEntry *z, - unsigned long keys[3],/* Updated on success. Must have been - initialized by caller. */ - unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN]) /* From zip file content */ +DecodeCryptHeader( + Tcl_Interp *interp, + ZipEntry *z, + unsigned long keys[3], /* Updated on success. Must have been + * initialized by caller. */ + unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN]) + /* From zip file content */ { int i; int ch; @@ -1065,11 +1067,12 @@ errorReturn: *------------------------------------------------------------------------ */ static char * -MapPathToZipfs(Tcl_Interp *interp, - const char *mountPath, /* Must be fully normalized */ - const char *path, /* Archive content path to map */ - Tcl_DString *dsPtr) /* Must be initialized and cleared - by caller */ +MapPathToZipfs( + Tcl_Interp *interp, + const char *mountPath, /* Must be fully normalized */ + const char *path, /* Archive content path to map */ + Tcl_DString *dsPtr) /* Must be initialized and cleared + * by caller */ { const char *joiner[2]; char *joinedPath; diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index 9123656..d8af241 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -846,7 +846,6 @@ StartNotifierThread(void) } UNLOCK_NOTIFIER_INIT; } - /* *---------------------------------------------------------------------- diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index 062139a..ba49842 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -185,8 +185,7 @@ PlatformEventsControl( Tcl_Panic("fstat: %s", strerror(errno)); } else if ((fdStat.st_mode & S_IFMT) == S_IFREG || (fdStat.st_mode & S_IFMT) == S_IFDIR - || (fdStat.st_mode & S_IFMT) == S_IFLNK - ) { + || (fdStat.st_mode & S_IFMT) == S_IFLNK) { switch (op) { case EV_ADD: if (isNew) { diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index 12df7e4..de185fb 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -14,7 +14,6 @@ #include #include - /* * Static procedures defined within this file. */ diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 1c8b53a..81f314f 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -36,7 +36,6 @@ #include #include - /* * Static procedures defined within this file. */ diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 67bff10..81e3af5 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -335,7 +335,6 @@ static int MacOSXGetLibraryPath(Tcl_Interp *interp, MODULE_SCOPE long tclMacOSXDarwinRelease; long tclMacOSXDarwinRelease = 0; #endif - /* *--------------------------------------------------------------------------- diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 8715b4d..4c08464 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -108,10 +108,10 @@ static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName, static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ - NULL, + NULL, NULL, /* Set option proc. */ FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ @@ -140,7 +140,6 @@ static const Tcl_ChannelType fileChannelType = { #define POSIX_EPOCH_AS_FILETIME \ ((long long) 116444736 * (long long) 1000000000) - /* *---------------------------------------------------------------------- diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index b7288b7..8b289b1 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -280,7 +280,6 @@ static Tcl_ThreadDataKey dataKey; */ SRWLOCK gConsoleLock; - /* Process-wide list of console handles. Access control through gConsoleLock */ static ConsoleHandleInfo *gConsoleHandleInfoList; @@ -905,7 +904,7 @@ ConsoleCheckProc( /* See note above loop why this can be accessed without locks */ chanInfoPtr->flags |= CONSOLE_EVENT_QUEUED; chanInfoPtr->numRefs += 1; /* So it does not go away while event - is in queue */ + * is in queue */ evPtr->header.proc = ConsoleEventProc; evPtr->chanInfoPtr = chanInfoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -973,7 +972,7 @@ ConsoleBlockModeProc( static int ConsoleCloseProc( - void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ + void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index e7164df..0af484d 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -53,7 +53,6 @@ enum { static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; - const char *const tclpFileAttrStrings[] = { "-archive", "-hidden", "-longname", "-readonly", "-shortname", "-system", NULL diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 6de1432..9995602 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -75,11 +75,10 @@ typedef struct TclPipeThreadInfo { * to do read/write operation. Additionally * used as signal to stop (state set to -1) */ volatile LONG state; /* Indicates current state of the thread */ - void *clientData; /* Referenced data of the main thread */ + void *clientData; /* Referenced data of the main thread */ HANDLE evWakeUp; /* Optional wake-up event worker set by shutdown */ } TclPipeThreadInfo; - /* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without * more overhead for finalize thread (should be executed anyway) * @@ -99,7 +98,6 @@ typedef struct TclPipeThreadInfo { #define PTI_STATE_END 4 /* thread should stop work (worker is busy) */ #define PTI_STATE_DOWN 8 /* worker is down */ - MODULE_SCOPE TclPipeThreadInfo * TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr, void *clientData, HANDLE wakeEvent); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 3f0269c..dbf3324 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1187,7 +1187,6 @@ TclpCreateProcess( } return result; } - /* *---------------------------------------------------------------------- diff --git a/win/tclWinPort.h b/win/tclWinPort.h index efd9ff2..8ab4548 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -246,7 +246,6 @@ typedef DWORD_PTR * PDWORD_PTR; # define EWOULDBLOCK 140 /* Operation would block */ #endif - /* Visual Studio doesn't have these, so just choose some high numbers */ #ifndef ESOCKTNOSUPPORT # define ESOCKTNOSUPPORT 240 /* Socket type not supported */ @@ -415,7 +414,6 @@ typedef DWORD_PTR * PDWORD_PTR; # endif #endif /* !S_ISLNK */ - /* * Define MAXPATHLEN in terms of MAXPATH if available */ @@ -524,7 +522,6 @@ typedef DWORD_PTR * PDWORD_PTR; /* This type is not defined in the Windows headers */ #define socklen_t int - /* * The following macros have trivial definitions, allowing generic code to * address platform-specific issues. diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index d8193b4..e27937e 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -613,7 +613,6 @@ SerialCloseProc( return EINVAL; } - if (serialPtr->validMask & TCL_READABLE) { PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR); CloseHandle(serialPtr->osRead.hEvent); @@ -1480,7 +1479,6 @@ TclWinOpenSerialChannel( infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, infoPtr, permissions); - SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite); PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR); diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index d99de8c..d5c582b 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -79,10 +79,10 @@ static CRITICAL_SECTION joinLock; #if TCL_THREADS typedef struct ThreadSpecificData { - HANDLE condEvent; /* Per-thread condition event */ + HANDLE condEvent; /* Per-thread condition event */ struct ThreadSpecificData *nextPtr; /* Queue pointers */ struct ThreadSpecificData *prevPtr; - int flags; /* See flags below */ + int flags; /* See flags below */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -120,7 +120,7 @@ typedef struct { static DWORD tlsKey; typedef struct { - Tcl_Mutex tlock; + Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; #endif /* USE_THREAD_ALLOC */ @@ -131,12 +131,12 @@ typedef struct { */ typedef struct { - LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */ - LPVOID lpParameter; /* Original startup data */ - unsigned int fpControl; /* Floating point control word from the + LPTHREAD_START_ROUTINE lpStartAddress; + /* Original startup routine */ + LPVOID lpParameter; /* Original startup data */ + unsigned int fpControl; /* Floating point control word from the * main thread */ } WinThread; - /* *---------------------------------------------------------------------- @@ -567,9 +567,9 @@ Tcl_MutexLock( */ if (*mutexPtr == NULL) { - csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION)); + csPtr = (CRITICAL_SECTION *) Tcl_Alloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); - *mutexPtr = (Tcl_Mutex)csPtr; + *mutexPtr = (Tcl_Mutex) csPtr; TclRememberMutex(mutexPtr); } TclpGlobalUnlock(); @@ -659,7 +659,7 @@ void Tcl_ConditionWait( Tcl_Condition *condPtr, /* Really (WinCondition **) */ Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */ - const Tcl_Time *timePtr) /* Timeout on waiting period */ + const Tcl_Time *timePtr) /* Timeout on waiting period */ { WinCondition *winCondPtr; /* Per-condition queue head */ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */ @@ -926,9 +926,6 @@ TclpFinalizeCondition( } } - - - /* * Additions by AOL for specialized thread memory allocator. */ @@ -1030,7 +1027,6 @@ TclpFreeAllocCache( } #endif /* USE_THREAD_ALLOC */ - void * TclpThreadCreateKey(void) { diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 77f7547..5636dc0 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -103,7 +103,6 @@ static struct { double microsecsScale; /* Denominator scale between clock / microsecs */ } wideClick = {0, 0, 0.0}; - /* * Declarations for functions defined later in this file. */ -- cgit v0.12 From ad83351823b5bb1c335ec44f1d1acf0a27202402 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 13 May 2024 07:55:28 +0000 Subject: Backout [b49efeca6a] (so people can judge whether this is just a textual improvement or not) --- doc/Tcl.n | 323 +++++++++++++++++++++++++++++++++++++------------------------- 1 file changed, 194 insertions(+), 129 deletions(-) diff --git a/doc/Tcl.n b/doc/Tcl.n index fbe77bc..0f784af 100644 --- a/doc/Tcl.n +++ b/doc/Tcl.n @@ -1,7 +1,6 @@ '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" Copyright (c) 2023 Nathan Coulter '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -17,191 +16,257 @@ Summary of Tcl language syntax. .SH DESCRIPTION .PP The following rules define the syntax and semantics of the Tcl language: -. -.IP "[1] \fBScript.\fR" -A script is composed of zero or more commands delimited by semi-colons or -newlines. -.IP "[2] \fBCommand.\fR" -A command is composed of zero or more words delimited by whitespace. The -replacement for a substitution is included verbatim in the word. For example, a -space in the replacement is included in the word rather than becoming a -delimiter, and \fI\\\\\fR becomes a single backslash in the word. Each word is -processed from left to right and each substitution is performed as soon as it -is complete. -For example, the command -.RS -.PP -.CS -set y [set x 0][incr x][incr x] -.CE -.PP -is composed of three words, and sets the value of \fIy\fR to \fI012\fR. -.PP -If hash -.PQ # -is the first character of what would otherwise be the first word of a command, -all characters up to the next newline are ignored. -.RE -. -.IP "[3] \fBBraced word.\fR" -If a word is enclosed in braces -.PQ { -and -.PQ } "" -, the braces are removed and the enclosed characters become the word. No -substitutions are performed. Nested pairs of braces may occur within the word. -A brace preceded by an odd number of backslashes is not considered part of a -pair, and neither brace nor the backslashes are removed from the word. -. -.IP "[4] \fBQuoted word.\fR" -If a word is enclosed in double quotes +.IP "[1] \fBCommands.\fR" +A Tcl script is a string containing one or more commands. +Semi-colons and newlines are command separators unless quoted as +described below. +Close brackets are command terminators during command substitution +(see below) unless quoted. +.IP "[2] \fBEvaluation.\fR" +A command is evaluated in two steps. +First, the Tcl interpreter breaks the command into \fIwords\fR +and performs substitutions as described below. +These substitutions are performed in the same way for all +commands. +Secondly, the first word is used to locate a routine to +carry out the command, and the remaining words of the command are +passed to that routine. +The routine is free to interpret each of its words +in any way it likes, such as an integer, variable name, list, +or Tcl script. +Different commands interpret their words differently. +.IP "[3] \fBWords.\fR" +Words of a command are separated by white space (except for +newlines, which are command separators). +.IP "[4] \fBDouble quotes.\fR" +If the first character of a word is double-quote .PQ \N'34' -, the double quotes are removed and the enclosed characters become the word. -Substitutions are performed. -. -.IP "[5] \fBList.\fR" -A list has the form of a single command. Newline is whitespace, and semicolon -has no special interpretation. There is no script evaluation so there is no -argument expansion, variable substitution, or command substitution: Dollar-sign -and open bracket have no special interpretation, and what would be argument -expansion in a script is invalid in a list. -. -.IP "[6] \fBArgument expansion.\fR" -If +then the word is terminated by the next double-quote character. +If semi-colons, close brackets, or white space characters +(including newlines) appear between the quotes then they are treated +as ordinary characters and included in the word. +Command substitution, variable substitution, and backslash substitution +are performed on the characters between the quotes as described below. +The double-quotes are not retained as part of the word. +.IP "[5] \fBArgument expansion.\fR" +If a word starts with the string .QW {*} -prefixes a word, it is removed. After any remaining enclosing braces or quotes -are processed and applicable substitutions performed, the word, which must -be a list, is removed from the command, and in its place each word in the -list becomes an additional word in the command. For example, -.CS -cmd a {*}{b [c]} d {*}{$e f {g h}} -.CE +followed by a non-whitespace character, then the leading +.QW {*} +is removed and the rest of the word is parsed and substituted as any other +word. After substitution, the word is parsed as a list (without command or +variable substitutions; backslash substitutions are performed as is normal for +a list and individual internal words may be surrounded by either braces or +double-quote characters), and its words are added to the command being +substituted. For instance, +.QW "cmd a {*}{b [c]} d {*}{$e f {g h}}" is equivalent to -.CS -cmd a b {[c]} d {$e} f {g h} . -.CE -. -.IP "[7] \fBEvaluation.\fR" -To evaluate a script, an interpreter evaluates each successive command. The -first word identifies a procedure, and the remaining words are passed to that -procedure for further evaluation. The procedure interprets each argument in -its own way, e.g. as an integer, variable name, list, mathematical expression, -script, or in some other arbitrary way. The result of the last command is the -result of the script. -. -.IP "[8] \fBCommand substitution.\fR" -Each pair of brackets +.QW "cmd a b {[c]} d {$e} f {g h}" . +.IP "[6] \fBBraces.\fR" +If the first character of a word is an open brace +.PQ { +and rule [5] does not apply, then +the word is terminated by the matching close brace +.PQ } "" . +Braces nest within the word: for each additional open +brace there must be an additional close brace (however, +if an open brace or close brace within the word is +quoted with a backslash then it is not counted in locating the +matching close brace). +No substitutions are performed on the characters between the +braces except for backslash-newline substitutions described +below, nor do semi-colons, newlines, close brackets, +or white space receive any special interpretation. +The word will consist of exactly the characters between the +outer braces, not including the braces themselves. +.IP "[7] \fBCommand substitution.\fR" +If a word contains an open bracket .PQ [ -and -.PQ ] "" -encloses a script and is replaced by the result of that script. -.IP "[9] \fBVariable substitution.\fR" -Each of the following forms begins with dollar sign +then Tcl performs \fIcommand substitution\fR. +To do this it invokes the Tcl interpreter recursively to process +the characters following the open bracket as a Tcl script. +The script may contain any number of commands and must be terminated +by a close bracket +.PQ ] "" . +The result of the script (i.e. the result of its last command) is +substituted into the word in place of the brackets and all of the +characters between them. +There may be any number of command substitutions in a single word. +Command substitution is not performed on words enclosed in braces. +.IP "[8] \fBVariable substitution.\fR" +If a word contains a dollar-sign .PQ $ -and is replaced by the value of the identified variable. \fIname\fR names the -variable and is composed of ASCII letters (\fBA\fR\(en\fBZ\fR and -\fBa\fR\(en\fBz\fR), digits (\fB0\fR\(en\fB9\fR), underscores, or namespace -delimiters (two or more colons). \fIindex\fR is the name of an individual -variable within an array variable, and may be empty. +followed by one of the forms +described below, then Tcl performs \fIvariable +substitution\fR: the dollar-sign and the following characters are +replaced in the word by the value of a variable. +Variable substitution may take any of the following forms: .RS .TP 15 \fB$\fIname\fR . -\fIname\fR may not be empty. +\fIName\fR is the name of a scalar variable; the name is a sequence +of one or more characters that are a letter, digit, underscore, +or namespace separators (two or more colons). +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). .TP 15 \fB$\fIname\fB(\fIindex\fB)\fR . -\fIname\fR may be empty. Substitutions are performed on \fIindex\fR. +\fIName\fR gives the name of an array variable and \fIindex\fR gives +the name of an element within that array. +\fIName\fR must contain only letters, digits, underscores, and +namespace separators, and may be an empty string. +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). +Command substitutions, variable substitutions, and backslash +substitutions are performed on the characters of \fIindex\fR. .TP 15 \fB${\fIname\fB}\fR . -\fIname\fR may be empty. -.TP 15 -\fB${\fIname(index)\fB}\fR -. -\fIname\fR may be empty. No substitutions are performed. +\fIName\fR is the name of a scalar variable or array element. It may contain +any characters whatsoever except for close braces. It indicates an array +element if \fIname\fR is in the form +.QW \fIarrayName\fB(\fIindex\fB)\fR +where \fIarrayName\fR does not contain any open parenthesis characters, +.QW \fB(\fR , +or close brace characters, +.QW \fB}\fR , +and \fIindex\fR can be any sequence of characters except for close brace +characters. No further +substitutions are performed during the parsing of \fIname\fR. +.PP +There may be any number of variable substitutions in a single word. +Variable substitution is not performed on words enclosed in braces. +.PP +Note that variables may contain character sequences other than those listed +above, but in that case other mechanisms must be used to access them (e.g., +via the \fBset\fR command's single-argument form). .RE -Variables that are not accessible through one of the forms above may be -accessed through other mechanisms, e.g. the \fBset\fR command. -.IP "[10] \fBBackslash substitution.\fR" -Each backslash +.IP "[9] \fBBackslash substitution.\fR" +If a backslash .PQ \e -that is not part of one of the forms listed below is removed, and the next -character is included in the word verbatim, which allows the inclusion of -characters that would normally be interpreted, namely whitespace, braces, -brackets, double quote, dollar sign, and backslash. The following sequences -are replaced as described: +appears within a word then \fIbackslash substitution\fR occurs. +In all cases but those described below the backslash is dropped and +the following character is treated as an ordinary +character and included in the word. +This allows characters such as double quotes, close brackets, +and dollar signs to be included in words without triggering +special processing. +The following table lists the backslash sequences that are +handled specially, along with the value that replaces each sequence. .RS .RS .RS .TP 7 \e\fBa\fR -. -Audible alert (bell) (U+7). +Audible alert (bell) (Unicode U+000007). .TP 7 \e\fBb\fR -. -Backspace (U+8). +Backspace (Unicode U+000008). .TP 7 \e\fBf\fR -. -Form feed (U+C). +Form feed (Unicode U+00000C). .TP 7 \e\fBn\fR -. -Newline (U+A). +Newline (Unicode U+00000A). .TP 7 \e\fBr\fR -. -Carriage-return (U+D). +Carriage-return (Unicode U+00000D). .TP 7 \e\fBt\fR -. -Tab (U+9). +Tab (Unicode U+000009). .TP 7 \e\fBv\fR -. -Vertical tab (U+B). +Vertical tab (Unicode U+00000B). .TP 7 \e\fB\fIwhiteSpace\fR . -Newline preceded by an odd number of backslashes, along with the consecutive -spaces and tabs that immediately follow it, is replaced by a single space. -Because this happens before the command is split into words, it occurs even -within braced words, and if the resulting space may subsequently be treated as -a word delimiter. +A single space character replaces the backslash, newline, and all spaces +and tabs after the newline. This backslash sequence is unique in that it +is replaced in a separate pre-pass before the command is actually parsed. +This means that it will be replaced even when it occurs between braces, +and the resulting space will be treated as a word separator if it is not +in braces or quotes. .TP 7 \e\e -. Backslash .PQ \e "" . .TP 7 \e\fIooo\fR . -Up to three octal digits form an eight-bit value for a Unicode character in the -range \fI0\fR\(en\fI377\fR, i.e. U+0\(enU+FF. Only the digits that result in a -number in this range are consumed. +The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal +value for the Unicode character that will be inserted, in the range +\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF). +The parser will stop just before this range overflows, or when +the maximum of three digits is reached. The upper bits of the Unicode +character will be 0. .TP 7 \e\fBx\fIhh\fR . -Up to two hexadecimal digits form an eight-bit value for a Unicode character in -the range \fI0\fR\(en\fIFF\fR. +The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit +hexadecimal value for the Unicode character that will be inserted. The upper +bits of the Unicode character will be 0 (i.e., the character will be in the +range U+000000\(enU+0000FF). .TP 7 \e\fBu\fIhhhh\fR . -Up to four hexadecimal digits form a 16-bit value for a Unicode character in -the range \fI0\fR\(en\fIFFFF\fR. +The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a +sixteen-bit hexadecimal value for the Unicode character that will be +inserted. The upper bits of the Unicode character will be 0 (i.e., the +character will be in the range U+000000\(enU+00FFFF). .TP 7 \e\fBU\fIhhhhhhhh\fR . -Up to eight hexadecimal digits form a 21-bit value for a Unicode character in -the range \fI0\fR\(en\fI10FFFF\fR. Only the digits that result in a number in -this range are consumed. +The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a +twenty-one-bit hexadecimal value for the Unicode character that will be +inserted, in the range U+000000\(enU+10FFFF. The parser will stop just +before this range overflows, or when the maximum of eight digits +is reached. The upper bits of the Unicode character will be 0. .RE .RE .PP +Backslash substitution is not performed on words enclosed in braces, +except for backslash-newline as described above. .RE -. +.IP "[10] \fBComments.\fR" +If a hash character +.PQ # +appears at a point where Tcl is +expecting the first character of the first word of a command, +then the hash character and the characters that follow it, up +through the next newline, are treated as a comment and ignored. +The comment character only has significance when it appears +at the beginning of a command. +.IP "[11] \fBOrder of substitution.\fR" +Each character is processed exactly once by the Tcl interpreter +as part of creating the words of a command. +For example, if variable substitution occurs then no further +substitutions are performed on the value of the variable; the +value is inserted into the word verbatim. +If command substitution occurs then the nested command is +processed entirely by the recursive call to the Tcl interpreter; +no substitutions are performed before making the recursive +call and no additional substitutions are performed on the result +of the nested script. +.RS +.PP +Substitutions take place from left to right, and each substitution is +evaluated completely before attempting to evaluate the next. Thus, a +sequence like +.PP +.CS +set y [set x 0][incr x][incr x] +.CE +.PP +will always set the variable \fIy\fR to the value, \fI012\fR. +.RE +.IP "[12] \fBSubstitution and word boundaries.\fR" +Substitutions do not affect the word boundaries of a command, +except for argument expansion as specified in rule [5]. +For example, during variable substitution the entire value of +the variable becomes part of a single word, even if the variable's +value contains spaces. .SH KEYWORDS backslash, command, comment, script, substitution, variable '\" Local Variables: -- cgit v0.12 From ce16d3c26c3df899a804f016210e63bddd4064b8 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 13 May 2024 10:34:11 +0000 Subject: interim fix for [9889f96f4da77e3b]: avoid lazy creation and compilation for clock-ensemble (unless the issue with line-number reset by recompile is solved) --- library/init.tcl | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/library/init.tcl b/library/init.tcl index f5d762c..da43bd4 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -101,17 +101,15 @@ if {[interp issafe]} { # Set up the 'clock' ensemble - proc clock args { + apply {{} { set cmdmap [dict create] foreach cmd {add clicks format microseconds milliseconds scan seconds} { dict set cmdmap $cmd ::tcl::clock::$cmd } namespace inscope ::tcl::clock [list namespace ensemble create -command \ - [uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \ - -map $cmdmap] + ::clock -map $cmdmap] ::tcl::unsupported::clock::configure -init-complete - uplevel 1 [info level 0] - } + }} } # Conditionalize for presence of exec. -- cgit v0.12 From 7e1f353db44ee7a1ef82811ca4e4ff02c7278802 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 13 May 2024 15:41:44 +0000 Subject: Clean up a lot of small whitespace issues This is the dullest commit ever. Sorry. --- generic/tcl.h | 11 +- generic/tclAlloc.c | 6 +- generic/tclArithSeries.c | 74 +++--- generic/tclAssembly.c | 21 +- generic/tclAsync.c | 14 +- generic/tclBasic.c | 51 ++-- generic/tclBinary.c | 45 ++-- generic/tclCkalloc.c | 40 +-- generic/tclClock.c | 37 +-- generic/tclClockFmt.c | 33 +-- generic/tclCmdAH.c | 49 ++-- generic/tclCmdIL.c | 223 +++++++--------- generic/tclCmdMZ.c | 14 +- generic/tclCompCmds.c | 83 +++--- generic/tclCompCmdsGR.c | 7 +- generic/tclCompCmdsSZ.c | 125 ++++----- generic/tclCompExpr.c | 6 +- generic/tclCompile.c | 51 ++-- generic/tclCompile.h | 10 +- generic/tclConfig.c | 2 +- generic/tclDate.h | 69 ++--- generic/tclDictObj.c | 44 +-- generic/tclDisassemble.c | 118 ++++---- generic/tclEncoding.c | 159 +++++------ generic/tclEnsemble.c | 224 ++++++++-------- generic/tclEnv.c | 15 +- generic/tclEvent.c | 33 ++- generic/tclExecute.c | 419 +++++++++++++++-------------- generic/tclFCmd.c | 10 +- generic/tclFileName.c | 110 ++++---- generic/tclHash.c | 62 +++-- generic/tclIO.c | 101 ++++--- generic/tclIO.h | 11 +- generic/tclIOCmd.c | 10 +- generic/tclIOGT.c | 14 +- generic/tclIORChan.c | 108 ++++---- generic/tclIORTrans.c | 82 +++--- generic/tclIOSock.c | 4 +- generic/tclIOUtil.c | 34 +-- generic/tclIndexObj.c | 40 +-- generic/tclInt.h | 184 ++++++------- generic/tclInterp.c | 88 +++--- generic/tclLink.c | 42 +-- generic/tclListObj.c | 335 ++++++++++++----------- generic/tclLiteral.c | 36 ++- generic/tclLoad.c | 9 +- generic/tclMain.c | 4 +- generic/tclNamesp.c | 43 ++- generic/tclNotify.c | 16 +- generic/tclOO.c | 42 +-- generic/tclOOBasic.c | 2 +- generic/tclOOCall.c | 15 +- generic/tclOODefineCmds.c | 4 +- generic/tclOOInt.h | 65 ++--- generic/tclOOMethod.c | 12 +- generic/tclObj.c | 363 ++++++++++++------------- generic/tclParse.c | 30 ++- generic/tclPathObj.c | 130 ++++----- generic/tclPipe.c | 2 +- generic/tclPkg.c | 46 ++-- generic/tclPosixStr.c | 6 +- generic/tclPreserve.c | 13 +- generic/tclProc.c | 16 +- generic/tclProcess.c | 2 +- generic/tclRegexp.c | 10 +- generic/tclResult.c | 112 ++++---- generic/tclScan.c | 22 +- generic/tclStrToD.c | 70 +++-- generic/tclStringObj.c | 83 +++--- generic/tclStubCall.c | 9 +- generic/tclStubInit.c | 112 ++++++-- generic/tclStubLib.c | 3 +- generic/tclThread.c | 6 +- generic/tclThreadAlloc.c | 8 +- generic/tclThreadStorage.c | 2 +- generic/tclTimer.c | 50 ++-- generic/tclTrace.c | 89 ++++--- generic/tclUtf.c | 97 +++---- generic/tclUtil.c | 412 ++++++++++++++-------------- generic/tclVar.c | 143 +++++----- generic/tclZipfs.c | 41 +-- generic/tclZlib.c | 2 +- macosx/tclMacOSXFCmd.c | 12 +- macosx/tclMacOSXNotify.c | 8 +- unix/tclAppInit.c | 2 +- unix/tclEpollNotfy.c | 43 ++- unix/tclKqueueNotfy.c | 6 +- unix/tclLoadDyld.c | 4 +- unix/tclLoadNext.c | 6 +- unix/tclLoadOSF.c | 2 +- unix/tclSelectNotfy.c | 6 +- unix/tclUnixChan.c | 38 +-- unix/tclUnixCompat.c | 116 ++++---- unix/tclUnixFCmd.c | 22 +- unix/tclUnixFile.c | 60 +++-- unix/tclUnixInit.c | 53 ++-- unix/tclUnixPipe.c | 22 +- unix/tclUnixPort.h | 2 +- unix/tclUnixSock.c | 650 ++++++++++++++++++++++----------------------- unix/tclUnixThrd.c | 4 +- unix/tclXtNotify.c | 8 +- win/tclWin32Dll.c | 4 +- win/tclWinChan.c | 33 +-- win/tclWinConsole.c | 109 ++++---- win/tclWinDde.c | 18 +- win/tclWinFCmd.c | 8 +- win/tclWinFile.c | 147 +++++----- win/tclWinInit.c | 20 +- win/tclWinInt.h | 2 +- win/tclWinLoad.c | 40 +-- win/tclWinNotify.c | 12 +- win/tclWinPipe.c | 22 +- win/tclWinPort.h | 12 +- win/tclWinReg.c | 14 +- win/tclWinSerial.c | 18 +- win/tclWinSock.c | 4 +- win/tclWinThrd.c | 4 +- 117 files changed, 3535 insertions(+), 3341 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 947e4a7..c475799 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1965,8 +1965,7 @@ typedef struct Tcl_EncodingType { Tcl_EncodingConvertProc *fromUtfProc; /* Function to convert from UTF-8 into * external encoding. */ - Tcl_FreeProc *freeProc; - /* If non-NULL, function to call when this + Tcl_FreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ @@ -2455,9 +2454,9 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); # define attemptckalloc Tcl_AttemptAlloc # ifdef _MSC_VER /* Silence invalid C4090 warnings */ -# define ckfree(a) Tcl_Free((void *)(a)) -# define ckrealloc(a,b) Tcl_Realloc((void *)(a),(b)) -# define attemptckrealloc(a,b) Tcl_AttemptRealloc((void *)(a),(b)) +# define ckfree(a) Tcl_Free((void *)(a)) +# define ckrealloc(a, b) Tcl_Realloc((void *)(a), (b)) +# define attemptckrealloc(a, b) Tcl_AttemptRealloc((void *)(a), (b)) # else # define ckfree Tcl_Free # define ckrealloc Tcl_Realloc @@ -2478,7 +2477,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); # undef Tcl_DumpActiveMemory # define Tcl_DumpActiveMemory(x) # undef Tcl_ValidateAllMemory -# define Tcl_ValidateAllMemory(x,y) +# define Tcl_ValidateAllMemory(x, y) #endif /* !TCL_MEM_DEBUG */ diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index b52d1b3..9a7dcba 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -305,7 +305,7 @@ TclpAlloc( #endif Tcl_MutexUnlock(allocMutexPtr); - return (void *)(overPtr+1); + return (void *)(overPtr + 1); } /* @@ -581,7 +581,7 @@ TclpRealloc( #endif Tcl_MutexUnlock(allocMutexPtr); - return (void *)(overPtr+1); + return (void *)(overPtr + 1); } maxSize = (size_t)1 << (i+3); expensive = 0; @@ -695,7 +695,7 @@ mstats( #undef TclpAlloc void * TclpAlloc( - size_t numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { return malloc(numBytes); } diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index fd1014c..1f15395 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -97,11 +97,11 @@ static int TclArithSeriesObjStep(Tcl_Obj *arithSeriesObj, /* ------------------------ ArithSeries object type -------------------------- */ static const Tcl_ObjType arithSeriesType = { - "arithseries", /* name */ - FreeArithSeriesInternalRep, /* freeIntRepProc */ - DupArithSeriesInternalRep, /* dupIntRepProc */ - UpdateStringOfArithSeries, /* updateStringProc */ - SetArithSeriesFromAny, /* setFromAnyProc */ + "arithseries", /* name */ + FreeArithSeriesInternalRep, /* freeIntRepProc */ + DupArithSeriesInternalRep, /* dupIntRepProc */ + UpdateStringOfArithSeries, /* updateStringProc */ + SetArithSeriesFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V2( ArithSeriesObjLength, TclArithSeriesObjIndex, @@ -231,21 +231,19 @@ maxPrecision( * * ArithSeriesLen -- * - * Compute the length of the equivalent list where - * every element is generated starting from *start*, - * and adding *step* to generate every successive element - * that's < *end* for positive steps, or > *end* for negative - * steps. + * Compute the length of the equivalent list where every element is + * generated starting from *start*, and adding *step* to generate every + * successive element that's < *end* for positive steps, or > *end* for + * negative steps. * * Results: * - * The length of the list generated by the given range, - * that may be zero. - * The function returns -1 if the list is of length infinite. + * The length of the list generated by the given range, that may be zero. + * The function returns -1 if the list is of length infinite. * * Side effects: * - * None. + * None. * *---------------------------------------------------------------------- */ @@ -497,13 +495,13 @@ NewArithSeriesDbl( * assignNumber -- * * Create the appropriate Tcl_Obj value for the given numeric values. - * Used locally only for decoding [lseq] numeric arguments. + * Used locally only for decoding [lseq] numeric arguments. * refcount = 0. * * Results: * * A Tcl_Obj pointer. - * No assignment on error. + * No assignment on error. * * Side Effects: * @@ -546,7 +544,7 @@ assignNumber( * * Creates a new ArithSeries object. Some arguments may be NULL and will * be computed based on the other given arguments. - * refcount = 0. + * refcount = 0. * * Results: * @@ -561,14 +559,14 @@ assignNumber( int TclNewArithSeriesObj( - Tcl_Interp *interp, /* For error reporting */ - Tcl_Obj **arithSeriesObj, /* return value */ - int useDoubles, /* Flag indicates values start, - ** end, step, are treated as doubles */ - Tcl_Obj *startObj, /* Starting value */ - Tcl_Obj *endObj, /* Ending limit */ - Tcl_Obj *stepObj, /* increment value */ - Tcl_Obj *lenObj) /* Number of elements */ + Tcl_Interp *interp, /* For error reporting */ + Tcl_Obj **arithSeriesObj, /* return value */ + int useDoubles, /* Flag indicates values start, + * end, step, are treated as doubles */ + Tcl_Obj *startObj, /* Starting value */ + Tcl_Obj *endObj, /* Ending limit */ + Tcl_Obj *stepObj, /* increment value */ + Tcl_Obj *lenObj) /* Number of elements */ { double dstart, dend, dstep; Tcl_WideInt start, end, step; @@ -781,8 +779,8 @@ TclArithSeriesObjStep( static int SetArithSeriesFromAny( - TCL_UNUSED(Tcl_Interp *), /* Used for error reporting if not NULL. */ - TCL_UNUSED(Tcl_Obj *)) /* The object to convert. */ + TCL_UNUSED(Tcl_Interp *), /* Used for error reporting if not NULL. */ + TCL_UNUSED(Tcl_Obj *)) /* The object to convert. */ { Tcl_Panic("SetArithSeriesFromAny: should never be called"); return TCL_ERROR; @@ -794,11 +792,11 @@ SetArithSeriesFromAny( * TclArithSeriesObjRange -- * * Makes a slice of an ArithSeries value. - * *arithSeriesObj must be known to be a valid list. + * *arithSeriesObj must be known to be a valid list. * * Results: * Returns a pointer to the sliced series. - * This may be a new object or the same object if not shared. + * This may be a new object or the same object if not shared. * * Side effects: * ?The possible conversion of the object referenced by listPtr? @@ -809,11 +807,11 @@ SetArithSeriesFromAny( int TclArithSeriesObjRange( - Tcl_Interp *interp, /* For error message(s) */ + Tcl_Interp *interp, /* For error message(s) */ Tcl_Obj *arithSeriesObj, /* List object to take a range from. */ Tcl_Size fromIdx, /* Index of first element to include. */ Tcl_Size toIdx, /* Index of last element to include. */ - Tcl_Obj **newObjPtr) /* return value */ + Tcl_Obj **newObjPtr) /* return value */ { ArithSeries *arithSeriesRepPtr; Tcl_Obj *startObj, *endObj, *stepObj; @@ -1007,16 +1005,16 @@ TclArithSeriesGetElements( * values appropriately swapped and the Step value sign is changed. * * Results: - * The result will be an ArithSeries in the reverse order. + * The result will be an ArithSeries in the reverse order. * * Side effects: - * The ogiginal obj will be modified and returned if it is not Shared. + * The ogiginal obj will be modified and returned if it is not Shared. * *---------------------------------------------------------------------- */ int TclArithSeriesObjReverse( - Tcl_Interp *interp, /* For error message(s) */ + Tcl_Interp *interp, /* For error message(s) */ Tcl_Obj *arithSeriesObj, /* List object to reverse. */ Tcl_Obj **newObjPtr) { @@ -1153,7 +1151,7 @@ UpdateStringOfArithSeries( char tmp[TCL_DOUBLE_SPACE + 2]; tmp[0] = 0; - Tcl_PrintDouble(NULL,d,tmp); + Tcl_PrintDouble(NULL, d, tmp); if ((bytlen + strlen(tmp)) > TCL_SIZE_MAX) { break; // overflow } @@ -1191,14 +1189,14 @@ UpdateStringOfArithSeries( * * Evaluate the "in" operation for expr * - * This can be done more efficiently in the Arith Series relative to - * doing a linear search as implemented in expr. + * This can be done more efficiently in the Arith Series relative to + * doing a linear search as implemented in expr. * * Results: * Boolean true or false (1/0) * * Side effects: - * None + * None * *---------------------------------------------------------------------- */ diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 7bec144..76f60fc 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -222,9 +222,9 @@ typedef struct AssemblyEnv { Tcl_HashTable labelHash; /* Hash table whose keys are labels and whose * values are 'label' objects storing the code * offsets of the labels. */ - Tcl_Size cmdLine; /* Current line number within the assembly + Tcl_Size cmdLine; /* Current line number within the assembly * code */ - Tcl_Size* clNext; /* Invisible continuation line for + Tcl_Size* clNext; /* Invisible continuation line for * [info frame] */ BasicBlock* head_bb; /* First basic block in the code */ BasicBlock* curr_bb; /* Current basic block */ @@ -322,10 +322,10 @@ static Tcl_DupInternalRepProc DupAssembleCodeInternalRep; static const Tcl_ObjType assembleCodeType = { "assemblecode", - FreeAssembleCodeInternalRep, /* freeIntRepProc */ - DupAssembleCodeInternalRep, /* dupIntRepProc */ - NULL, /* updateStringProc */ - NULL, /* setFromAnyProc */ + FreeAssembleCodeInternalRep, + DupAssembleCodeInternalRep, + NULL, /* updateStringProc */ + NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; @@ -851,8 +851,7 @@ CompileAssembleObj( Interp *iPtr = (Interp *) interp; /* Internals of the interpreter */ CompileEnv compEnv; /* Compilation environment structure */ - ByteCode *codePtr = NULL; - /* Bytecode resulting from the assembly */ + 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 */ @@ -1271,7 +1270,7 @@ AssembleOneLine( Tcl_Size operand1Len; /* String length of the operand */ int opnd; /* Integer representation of an operand */ int litIndex; /* Literal pool index of a constant */ - Tcl_Size localVar; /* LVT index of a local variable */ + Tcl_Size localVar; /* LVT index of a local variable */ int flags; /* Flags for a basic block */ JumptableInfo* jtPtr; /* Pointer to a jumptable */ int infoIndex; /* Index of the jumptable in auxdata */ @@ -1968,7 +1967,7 @@ CreateMirrorJumpTable( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Obj* jumps) /* List of alternating keywords and labels */ { - Tcl_Size objc; /* Number of elements in the 'jumps' list */ + Tcl_Size objc; /* Number of elements in the 'jumps' list */ Tcl_Obj** objv; /* Pointers to the elements in the list */ CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -3825,7 +3824,7 @@ ProcessCatchesInBasicBlock( */ if (bbPtr->flags & BB_JUMPTABLE) { - for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch); + for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable, &jtSearch); result == TCL_OK && jtEntry != NULL; jtEntry = Tcl_NextHashEntry(&jtSearch)) { targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry); diff --git a/generic/tclAsync.c b/generic/tclAsync.c index f0f0c9c..e6144b2 100644 --- a/generic/tclAsync.c +++ b/generic/tclAsync.c @@ -30,7 +30,7 @@ typedef struct AsyncHandler { * for the process. */ Tcl_AsyncProc *proc; /* Procedure to call when handler is * invoked. */ - void *clientData; /* Value to pass to handler when it is + void *clientData; /* Value to pass to handler when it is * invoked. */ struct ThreadSpecificData *originTsd; /* Used in Tcl_AsyncMark to modify thread- @@ -38,7 +38,7 @@ typedef struct AsyncHandler { * associated to. */ Tcl_ThreadId originThrdId; /* Origin thread where this token was created * and where it will be yielded. */ - void *notifierData; /* Platform notifier data or NULL. */ + void *notifierData; /* Platform notifier data or NULL. */ } AsyncHandler; typedef struct ThreadSpecificData { @@ -142,7 +142,7 @@ Tcl_AsyncHandler Tcl_AsyncCreate( Tcl_AsyncProc *proc, /* Procedure to call when handler is * invoked. */ - void *clientData) /* Argument to pass to handler. */ + void *clientData) /* Argument to pass to handler. */ { AsyncHandler *asyncPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -190,7 +190,7 @@ Tcl_AsyncCreate( void Tcl_AsyncMark( - Tcl_AsyncHandler async) /* Token for handler. */ + Tcl_AsyncHandler async) /* Token for handler. */ { AsyncHandler *token = (AsyncHandler *) async; @@ -224,8 +224,8 @@ Tcl_AsyncMark( int Tcl_AsyncMarkFromSignal( - Tcl_AsyncHandler async, /* Token for handler. */ - int sigNumber) /* Signal number. */ + Tcl_AsyncHandler async, /* Token for handler. */ + int sigNumber) /* Signal number. */ { #if TCL_THREADS AsyncHandler *token = (AsyncHandler *) async; @@ -378,7 +378,7 @@ Tcl_AsyncInvoke( void Tcl_AsyncDelete( - Tcl_AsyncHandler async) /* Token for handler to delete. */ + Tcl_AsyncHandler async) /* Token for handler to delete. */ { AsyncHandler *asyncPtr = (AsyncHandler *) async; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 3940d4b..b017e78 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -151,17 +151,21 @@ TCL_DECLARE_MUTEX(commandTypeLock); * are used to save the evaluation state between NR calls to each coro. */ -#define SAVE_CONTEXT(context) \ - (context).framePtr = iPtr->framePtr; \ - (context).varFramePtr = iPtr->varFramePtr; \ - (context).cmdFramePtr = iPtr->cmdFramePtr; \ - (context).lineLABCPtr = iPtr->lineLABCPtr - -#define RESTORE_CONTEXT(context) \ - iPtr->framePtr = (context).framePtr; \ - iPtr->varFramePtr = (context).varFramePtr; \ - iPtr->cmdFramePtr = (context).cmdFramePtr; \ - iPtr->lineLABCPtr = (context).lineLABCPtr +#define SAVE_CONTEXT(context) \ + do { \ + (context).framePtr = iPtr->framePtr; \ + (context).varFramePtr = iPtr->varFramePtr; \ + (context).cmdFramePtr = iPtr->cmdFramePtr; \ + (context).lineLABCPtr = iPtr->lineLABCPtr; \ + } while (0) + +#define RESTORE_CONTEXT(context) \ + do { \ + iPtr->framePtr = (context).framePtr; \ + iPtr->varFramePtr = (context).varFramePtr; \ + iPtr->cmdFramePtr = (context).cmdFramePtr; \ + iPtr->lineLABCPtr = (context).lineLABCPtr; \ + } while (0) /* * Static functions in this file: @@ -807,8 +811,8 @@ Tcl_CreateInterp(void) if (sizeof(time_t) != 8) { Tcl_Panic(" is not compatible with VS2005+"); } - if ((offsetof(Tcl_StatBuf,st_atime) != 32) - || (offsetof(Tcl_StatBuf,st_ctime) != 48)) { + if ((offsetof(Tcl_StatBuf, st_atime) != 32) + || (offsetof(Tcl_StatBuf, st_ctime) != 48)) { Tcl_Panic(" is not compatible with VS2005+"); } #endif @@ -891,11 +895,11 @@ Tcl_CreateInterp(void) iPtr->errorStack = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(iPtr->errorStack); iPtr->resetErrorStack = 1; - TclNewLiteralStringObj(iPtr->upLiteral,"UP"); + TclNewLiteralStringObj(iPtr->upLiteral, "UP"); Tcl_IncrRefCount(iPtr->upLiteral); - TclNewLiteralStringObj(iPtr->callLiteral,"CALL"); + TclNewLiteralStringObj(iPtr->callLiteral, "CALL"); Tcl_IncrRefCount(iPtr->callLiteral); - TclNewLiteralStringObj(iPtr->innerLiteral,"INNER"); + TclNewLiteralStringObj(iPtr->innerLiteral, "INNER"); Tcl_IncrRefCount(iPtr->innerLiteral); iPtr->innerContext = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(iPtr->innerContext); @@ -1194,7 +1198,7 @@ Tcl_CreateInterp(void) * Register the builtin math functions. */ - nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL); + nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL, NULL); if (nsPtr == NULL) { Tcl_Panic("Can't create math function namespace"); } @@ -3674,7 +3678,7 @@ Tcl_DeleteCommandFromToken( CommandTrace *tracePtr; /* CallCommandTraces() does not cmdPtr, that's * done just before Tcl_DeleteCommandFromToken() returns */ - CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); + CallCommandTraces(iPtr, cmdPtr, NULL, NULL, TCL_TRACE_DELETE); /* * Now delete these traces. @@ -4596,7 +4600,8 @@ Dispatch( } if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) { Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr); - const char *a[6]; Tcl_Size i[2]; + const char *a[6]; + Tcl_Size i[2]; TclDTraceInfo(info, a, i); TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); @@ -8905,7 +8910,7 @@ TclNRTailcallEval( */ TclMarkTailcall(interp); - TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); + TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL, NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; return TclNREvalObjv(interp, objc - 1, objv + 1, 0, NULL); } @@ -9089,7 +9094,7 @@ DeleteCoroutine( NRE_callback *rootPtr = TOP_CB(interp); if (COR_IS_SUSPENDED(corPtr)) { - TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr); + TclNRRunCallbacks(interp, RewindCoroutine(corPtr, TCL_OK), rootPtr); } } @@ -9311,7 +9316,7 @@ TclNREvalList( Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); - TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); + TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL, NULL); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } @@ -9830,7 +9835,7 @@ TclNRCoroutineObjCmd( Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); - for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch); + for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr, &hSearch); hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) { int isNew; Tcl_HashEntry *newPtr = diff --git a/generic/tclBinary.c b/generic/tclBinary.c index d95452b..b2e9e03 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -183,14 +183,16 @@ typedef struct { * above. */ } ByteArray; -#define BYTEARRAY_MAX_LEN (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes)) +#define BYTEARRAY_MAX_LEN \ + (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes)) #define BYTEARRAY_SIZE(len) \ - ( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \ + ( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \ ? (Tcl_Panic("negative length specified or max size of a Tcl value exceeded"), 0) \ : (offsetof(ByteArray, bytes) + (len)) ) -#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1) +#define GET_BYTEARRAY(irPtr) \ + ((ByteArray *) (irPtr)->twoPtrValue.ptr1) #define SET_BYTEARRAY(irPtr, baPtr) \ - (irPtr)->twoPtrValue.ptr1 = (baPtr) + (irPtr)->twoPtrValue.ptr1 = (baPtr) int TclIsPureByteArray( @@ -440,7 +442,7 @@ unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ Tcl_Size numBytes) /* Number of bytes in resized array - * Must be >= 0 */ + * Must be >= 0 */ { ByteArray *byteArrayPtr; Tcl_ObjInternalRep *irPtr; @@ -736,7 +738,7 @@ TclAppendBytesToByteArray( Tcl_ObjInternalRep *irPtr; if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); + Tcl_Panic("%s called with shared object", "TclAppendBytesToByteArray"); } if (len < 0) { Tcl_Panic("%s must be called with definite number of bytes to append", @@ -2040,7 +2042,7 @@ FormatNumber( if (fabs(dvalue) > (FLT_MAX + pow(2, (FLT_MAX_EXP - FLT_MANT_DIG - 1)))) { fvalue = (dvalue >= 0.0) ? INFINITY : -INFINITY; // c99 } else { - fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; + fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; } } else { fvalue = (float) dvalue; @@ -2586,19 +2588,19 @@ BinaryDecodeHex( */ #define OUTPUT(c) \ - do { \ - *cursor++ = (c); \ - outindex++; \ - if (maxlen > 0 && cursor != limit) { \ - if (outindex == maxlen) { \ - memcpy(cursor, wrapchar, wrapcharlen); \ - cursor += wrapcharlen; \ - outindex = 0; \ - } \ - } \ - if (cursor > limit) { \ - Tcl_Panic("limit hit"); \ - } \ + do { \ + *cursor++ = (c); \ + outindex++; \ + if (maxlen > 0 && cursor != limit) { \ + if (outindex == maxlen) { \ + memcpy(cursor, wrapchar, wrapcharlen); \ + cursor += wrapcharlen; \ + outindex = 0; \ + } \ + } \ + if (cursor > limit) { \ + Tcl_Panic("limit hit"); \ + } \ } while (0) static int @@ -2783,7 +2785,8 @@ BinaryEncodeUu( case '\v': case '\f': case '\r': - p++; numBytes--; + p++; + numBytes--; continue; case '\n': numBytes--; diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index a95fc83..707f6d1 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -171,7 +171,7 @@ TclDumpMemoryInfo( char buf[1024]; if (clientData == NULL) { - return 0; + return 0; } snprintf(buf, sizeof(buf), "total mallocs %10" TCL_Z_MODIFIER "u\n" @@ -447,7 +447,7 @@ Tcl_DbCkalloc( } if (alloc_tracing) { - fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", + fprintf(stderr, "Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", result->body, size, file, line); } @@ -536,7 +536,7 @@ Tcl_AttemptDbCkalloc( } if (alloc_tracing) { - fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", + fprintf(stderr, "Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", result->body, size, file, line); } @@ -826,12 +826,12 @@ MemoryCmd( Tcl_DStringFree(&buffer); if (result != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s", - TclGetString(objv[2]), Tcl_PosixError(interp))); + TclGetString(objv[2]), Tcl_PosixError(interp))); return TCL_ERROR; } return TCL_OK; } - if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) { + if (strcmp(TclGetString(objv[1]), "break_on_malloc") == 0) { Tcl_WideInt value; if (objc != 3) { goto argError; @@ -842,7 +842,7 @@ MemoryCmd( break_on_malloc = value; return TCL_OK; } - if (strcmp(TclGetString(objv[1]),"info") == 0) { + if (strcmp(TclGetString(objv[1]), "info") == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n", "total mallocs", total_mallocs, "total frees", total_frees, @@ -856,7 +856,7 @@ MemoryCmd( if (objc != 3) { goto bad_suboption; } - init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0); + init_malloced_bodies = (strcmp(TclGetString(objv[2]), "on") == 0); return TCL_OK; } if (strcmp(TclGetString(objv[1]), "objs") == 0) { @@ -871,8 +871,8 @@ MemoryCmd( fileP = fopen(fileName, "w"); if (fileP == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot open output file: %s", - Tcl_PosixError(interp))); + "cannot open output file: %s", + Tcl_PosixError(interp))); return TCL_ERROR; } TclDbDumpActiveObjects(fileP); @@ -880,7 +880,7 @@ MemoryCmd( Tcl_DStringFree(&buffer); return TCL_OK; } - if (strcmp(TclGetString(objv[1]),"onexit") == 0) { + if (strcmp(TclGetString(objv[1]), "onexit") == 0) { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "file"); return TCL_ERROR; @@ -890,11 +890,11 @@ MemoryCmd( return TCL_ERROR; } onExitMemDumpFileName = dumpFile; - strcpy(onExitMemDumpFileName,fileName); + strcpy(onExitMemDumpFileName, fileName); Tcl_DStringFree(&buffer); return TCL_OK; } - if (strcmp(TclGetString(objv[1]),"tag") == 0) { + if (strcmp(TclGetString(objv[1]), "tag") == 0) { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "file"); return TCL_ERROR; @@ -908,15 +908,15 @@ MemoryCmd( memcpy(curTagPtr->string, TclGetString(objv[2]), len + 1); return TCL_OK; } - if (strcmp(TclGetString(objv[1]),"trace") == 0) { + if (strcmp(TclGetString(objv[1]), "trace") == 0) { if (objc != 3) { goto bad_suboption; } - alloc_tracing = (strcmp(TclGetString(objv[2]),"on") == 0); + alloc_tracing = (strcmp(TclGetString(objv[2]), "on") == 0); return TCL_OK; } - if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) { + if (strcmp(TclGetString(objv[1]), "trace_on_at_malloc") == 0) { Tcl_WideInt value; if (objc != 3) { goto argError; @@ -927,18 +927,18 @@ MemoryCmd( trace_on_at_malloc = value; return TCL_OK; } - if (strcmp(TclGetString(objv[1]),"validate") == 0) { + if (strcmp(TclGetString(objv[1]), "validate") == 0) { if (objc != 3) { goto bad_suboption; } - validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0); + validate_memory = (strcmp(TclGetString(objv[2]), "on") == 0); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": should be active, break_on_malloc, info, " - "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", - TclGetString(objv[1]))); + "bad option \"%s\": should be active, break_on_malloc, info, " + "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", + TclGetString(objv[1]))); return TCL_ERROR; argError: diff --git a/generic/tclClock.c b/generic/tclClock.c index 412f616..1675f54 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -349,7 +349,7 @@ ClockConfigureClear( */ static void ClockDeleteCmdProc( - void *clientData) /* Opaque pointer to the client data */ + void *clientData) /* Opaque pointer to the client data */ { ClockClientData *data = (ClockClientData *)clientData; int i; @@ -649,7 +649,7 @@ NormLocaleObj( if ((localeObj->length == 1 /* C */ && strcasecmp(loc, Literals[LIT_C]) == 0) || (dataPtr->defaultLocale && (loc2 = TclGetString(dataPtr->defaultLocale)) - && localeObj->length == dataPtr->defaultLocale->length + && localeObj->length == dataPtr->defaultLocale->length && strcasecmp(loc, loc2) == 0)) { *mcDictObj = dataPtr->defaultLocaleDict; return dataPtr->defaultLocale ? @@ -3287,7 +3287,7 @@ ClockParseFmtScnArgs( ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ TclDateFields *date, /* Extracted date-time corresponding base * (by scan or add) resp. clockval (by format) */ - Tcl_Size objc, /* Parameter count */ + Tcl_Size objc, /* Parameter count */ Tcl_Obj *const objv[], /* Parameter vector */ ClockOperation operation, /* What operation are we doing: format, scan, add */ const char *syntax) /* Syntax of the current command */ @@ -3480,7 +3480,7 @@ ClockParseFmtScnArgs( /* extact fields from base */ date->seconds = baseVal; if (ClockGetDateFields(dataPtr, interp, date, opts->timezoneObj, - GREGORIAN_CHANGE_DATE) != TCL_OK) { + GREGORIAN_CHANGE_DATE) != TCL_OK) { /* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */ return TCL_ERROR; } @@ -3504,7 +3504,7 @@ ClockParseFmtScnArgs( /*---------------------------------------------------------------------- * - * ClockFormatObjCmd -- , clock format -- + * ClockFormatObjCmd, [clock format] -- * * This function is invoked to process the Tcl "clock format" command. * @@ -3573,7 +3573,7 @@ ClockFormatObjCmd( /*---------------------------------------------------------------------- * - * ClockScanObjCmd -- , clock scan -- + * ClockScanObjCmd, [clock scan] -- * * This function is invoked to process the Tcl "clock scan" command. * @@ -3630,7 +3630,8 @@ ClockScanObjCmd( } /* seconds are in localSeconds (relative base date), so reset time here */ - yyHour = yyMinutes = yySeconds = yySecondOfDay = 0; yyMeridian = MER24; + yyHour = yyMinutes = yySeconds = yySecondOfDay = 0; + yyMeridian = MER24; /* If free scan */ if (opts.formatObj == NULL) { @@ -4309,7 +4310,7 @@ ClockWeekdaysOffs( /*---------------------------------------------------------------------- * - * ClockAddObjCmd -- , clock add -- + * ClockAddObjCmd, [clock add] -- * * Adds an offset to a given time. * @@ -4566,16 +4567,16 @@ ClockSafeCatchCmd( Tcl_Obj *const objv[]) { typedef struct { - int status; /* return code status */ - int flags; /* Each remaining field saves the */ - int returnLevel; /* corresponding field of the Interp */ - int returnCode; /* struct. These fields taken together are */ - Tcl_Obj *errorInfo; /* the "state" of the interp. */ - Tcl_Obj *errorCode; - Tcl_Obj *returnOpts; - Tcl_Obj *objResult; - Tcl_Obj *errorStack; - int resetErrorStack; + int status; /* return code status */ + int flags; /* Each remaining field saves the */ + int returnLevel; /* corresponding field of the Interp */ + int returnCode; /* struct. These fields taken together are */ + Tcl_Obj *errorInfo; /* the "state" of the interp. */ + Tcl_Obj *errorCode; + Tcl_Obj *returnOpts; + Tcl_Obj *objResult; + Tcl_Obj *errorStack; + int resetErrorStack; } InterpState; Interp *iPtr = (Interp *)interp; diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 0afc458..8340ece 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -632,11 +632,11 @@ ClockFmtScnStorageDelete( */ static const Tcl_ObjType ClockFmtObjType = { - "clock-format", /* name */ - ClockFmtObj_FreeInternalRep, /* freeIntRepProc */ - ClockFmtObj_DupInternalRep, /* dupIntRepProc */ - ClockFmtObj_UpdateString, /* updateStringProc */ - ClockFmtObj_SetFromAny, /* setFromAnyProc */ + "clock-format", /* name */ + ClockFmtObj_FreeInternalRep,/* freeIntRepProc */ + ClockFmtObj_DupInternalRep, /* dupIntRepProc */ + ClockFmtObj_UpdateString, /* updateStringProc */ + ClockFmtObj_SetFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; @@ -1046,7 +1046,9 @@ FindTokenBegin( goto findChar; case CTOKT_SPACE: - while (!isspace(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) {} + while (!isspace(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) { + // empty body + } return p; case CTOKT_CHAR: @@ -2140,13 +2142,13 @@ EstimateTokenCount( return ++tokcnt; } -#define AllocTokenInChain(tok, chain, tokCnt, type) \ - if (++(tok) >= (chain) + (tokCnt)) { \ - chain = (type)Tcl_Realloc((char *)(chain), \ - (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \ - (tok) = (chain) + (tokCnt); \ - (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ - } \ +#define AllocTokenInChain(tok, chain, tokCnt, type) \ + if (++(tok) >= (chain) + (tokCnt)) { \ + chain = (type)Tcl_Realloc((char *)(chain), \ + (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok)));\ + (tok) = (chain) + (tokCnt); \ + (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ + } \ memset(tok, 0, sizeof(*(tok))); /* @@ -2293,7 +2295,7 @@ ClockGetOrParseScanFormat( tokCnt++; continue; } - word_tok: + word_tok: { /* try continue with previous word token */ ClockScanToken *wordTok = tok - 1; @@ -3336,8 +3338,7 @@ ClockGetOrParseFmtFormat( continue; } default: - word_tok: - { + word_tok: { /* try continue with previous word token */ ClockFormatToken *wordTok = tok - 1; diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index ab5fbb0..ce96c9b 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -405,21 +405,21 @@ TclInitEncodingCmd( * * EncodingConvertParseOptions -- * - * Common routine for parsing arguments passed to encoding convertfrom - * and encoding convertto. + * Common routine for parsing arguments passed to encoding convertfrom + * and encoding convertto. * * Results: - * TCL_OK or TCL_ERROR. + * TCL_OK or TCL_ERROR. * * Side effects: - * On success, - * - *encPtr is set to the encoding. Must be freed with Tcl_FreeEncoding - * if non-NULL - * - *dataObjPtr is set to the Tcl_Obj containing the data to encode or - * decode - * - *profilePtr is set to encoding error handling profile - * - *failVarPtr is set to -failindex option value or NULL - * On error, all of the above are uninitialized. + * On success, + * - *encPtr is set to the encoding. Must be freed with Tcl_FreeEncoding + * if non-NULL + * - *dataObjPtr is set to the Tcl_Obj containing the data to encode or + * decode + * - *profilePtr is set to encoding error handling profile + * - *failVarPtr is set to -failindex option value or NULL + * On error, all of the above are uninitialized. * *------------------------------------------------------------------------ */ @@ -524,7 +524,7 @@ EncodingConvertfromObjCmd( Tcl_Obj *data; /* Byte array to convert */ Tcl_DString ds; /* Buffer to hold the string */ Tcl_Encoding encoding; /* Encoding to use */ - Tcl_Size length = 0; /* Length of the byte array being converted */ + Tcl_Size length = 0; /* Length of the byte array being converted */ const char *bytesPtr; /* Pointer to the first byte of the array */ int flags; int result; @@ -2346,13 +2346,13 @@ StoreStatData( if (varName == NULL) { TclNewObj(result); Tcl_IncrRefCount(result); -#define DOBJPUT(key, objValue) \ - Tcl_DictObjPut(NULL, result, \ - Tcl_NewStringObj((key), -1), \ - (objValue)); +#define DOBJPUT(key, objValue) \ + Tcl_DictObjPut(NULL, result, \ + Tcl_NewStringObj((key), TCL_AUTO_LENGTH), \ + (objValue)); DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev)); DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino)); - DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink)); + DOBJPUT("nlink",Tcl_NewWideIntObj((long)statPtr->st_nlink)); DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid)); DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid)); DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size)); @@ -2362,12 +2362,12 @@ StoreStatData( #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize)); #endif - DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr))); - DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr))); - DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr))); + DOBJPUT("atime",Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr))); + DOBJPUT("mtime",Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr))); + DOBJPUT("ctime",Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr))); mode = (unsigned short) statPtr->st_mode; DOBJPUT("mode", Tcl_NewWideIntObj(mode)); - DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1)); + DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), TCL_AUTO_LENGTH)); #undef DOBJPUT Tcl_SetObjResult(interp, result); Tcl_DecrRefCount(result); @@ -2384,7 +2384,8 @@ StoreStatData( TclNewLiteralStringObj(field, fieldName); \ Tcl_IncrRefCount(field); \ value = (object); \ - if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \ + if (Tcl_ObjSetVar2(interp, varName, field, value, \ + TCL_LEAVE_ERR_MSG) == NULL) { \ TclDecrRefCount(field); \ return TCL_ERROR; \ } \ @@ -2832,7 +2833,7 @@ EachloopCmd( &statePtr->varcList[i], &statePtr->varvList[i]); /* Values */ - if (TclObjTypeHasProc(objv[2+i*2],indexProc)) { + if (TclObjTypeHasProc(objv[2+i*2], indexProc)) { /* Special case for AbstractList */ statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]); if (statePtr->aCopyList[i] == NULL) { @@ -2982,7 +2983,7 @@ ForeachAssignments( for (i=0 ; inumLists ; i++) { int isAbstractList = - TclObjTypeHasProc(statePtr->aCopyList[i],indexProc) != NULL; + TclObjTypeHasProc(statePtr->aCopyList[i], indexProc) != NULL; for (v=0 ; vvarcList[i] ; v++) { k = statePtr->index[i]++; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 37c9822..562908e 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -788,7 +788,7 @@ InfoCommandsCmd( cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { - if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { + if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); } @@ -1263,7 +1263,7 @@ TclInfoFrame( { Interp *iPtr = (Interp *) interp; Tcl_Obj *tmpObj; - Tcl_Obj *lv[20] = {NULL}; /* Keep uptodate when more keys are added to + Tcl_Obj *lv[20] = {NULL}; /* Keep uptodate when more keys are added to * the dict. */ int lc = 0; /* @@ -1282,8 +1282,8 @@ TclInfoFrame( */ #define ADD_PAIR(name, value) \ - TclNewLiteralStringObj(tmpObj, name); \ - lv[lc++] = tmpObj; \ + TclNewLiteralStringObj(tmpObj, name); \ + lv[lc++] = tmpObj; \ lv[lc++] = (value) switch (framePtr->type) { @@ -2426,7 +2426,7 @@ int Tcl_LinsertObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; @@ -2519,9 +2519,8 @@ int Tcl_ListObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) - /* The argument objects. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ { /* * If there are no list elements, the result is an empty object. @@ -2556,8 +2555,7 @@ Tcl_LlengthObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) - /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size listLen; int result; @@ -2605,8 +2603,7 @@ Tcl_LpopObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) - /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size listLen; int copied = 0, result; @@ -2725,8 +2722,7 @@ Tcl_LrangeObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) - /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int result; Tcl_Size listLen, first, last; @@ -2937,9 +2933,8 @@ int Tcl_LrepeatObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) - /* The argument objects. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_WideInt elementCount, i; Tcl_Size totalElems; @@ -3874,7 +3869,7 @@ Tcl_LsearchObjCmd( break; case REAL: - result = Tcl_GetDoubleFromObj(interp,itemPtr, &objDouble); + result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble); if (result != TCL_OK) { if (listPtr) { Tcl_DecrRefCount(listPtr); @@ -4034,10 +4029,10 @@ Tcl_LsearchObjCmd( static SequenceDecoded SequenceIdentifyArgument( - Tcl_Interp *interp, /* for error reporting */ - Tcl_Obj *argPtr, /* Argument to decode */ - Tcl_Obj **numValuePtr, /* Return numeric value */ - int *keywordIndexPtr) /* Return keyword enum */ + Tcl_Interp *interp, /* for error reporting */ + Tcl_Obj *argPtr, /* Argument to decode */ + Tcl_Obj **numValuePtr, /* Return numeric value */ + int *keywordIndexPtr) /* Return keyword enum */ { int status; SequenceOperators opmode; @@ -4169,49 +4164,48 @@ Tcl_LseqObjCmd( * digit. */ if (objc > 6) { - /* Too many arguments */ - arg_key=0; + /* Too many arguments */ + arg_key=0; } else for (i=1; i end) || /* Range begins after end of string */ (last < first)) { /* Range begins after it starts */ /* @@ -2907,7 +2907,7 @@ StringLowerCmd( Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; - if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[2], length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { @@ -2992,7 +2992,7 @@ StringUpperCmd( Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; - if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[2], length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { @@ -3077,7 +3077,7 @@ StringTitleCmd( Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; - if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[2], length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { @@ -3702,7 +3702,7 @@ TclNRSwitchObjCmd( } break; case OPT_GLOB: - if (Tcl_StringCaseMatch(TclGetString(stringObj),pattern,noCase)) { + if (Tcl_StringCaseMatch(TclGetString(stringObj), pattern, noCase)) { goto matchFound; } break; @@ -5309,7 +5309,7 @@ TclListLines( Tcl_Size line, /* Line the list as a whole starts on. */ Tcl_Size n, /* #elements in lines */ Tcl_Size *lines, /* Array of line numbers, to fill. */ - Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of + Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of * derived continuation data */ { const char *listStr = TclGetString(listObj); diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index bad58f6..30244ee 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -379,9 +379,9 @@ TclCompileArraySetCmd( localIndex = TclFindCompiledLocal(varTokenPtr->start, varTokenPtr->size, 1, envPtr); PushStringLiteral(envPtr, "0"); - TclEmitInstInt4(INST_REVERSE, 2, envPtr); + TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitInstInt4(INST_UPVAR, localIndex, envPtr); - TclEmitOpcode(INST_POP, envPtr); + TclEmitOpcode( INST_POP, envPtr); } /* @@ -391,9 +391,11 @@ TclCompileArraySetCmd( keyVar = AnonymousLocal(envPtr); valVar = AnonymousLocal(envPtr); - infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *)); + infoPtr = (ForeachInfo *) + Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *)); infoPtr->numLists = 1; - infoPtr->varLists[0] = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(Tcl_Size)); + infoPtr->varLists[0] = (ForeachVarList *) + Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(Tcl_Size)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; @@ -967,7 +969,7 @@ TclCompileConstCmd( * that. */ if (!isScalar) { - return TCL_ERROR; + return TCL_ERROR; } /* @@ -1160,7 +1162,7 @@ TclCompileDictIncrCmd( incrTokenPtr = TokenAfter(keyTokenPtr); if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr); + return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } word = incrTokenPtr[1].start; numBytes = incrTokenPtr[1].size; @@ -1170,7 +1172,7 @@ TclCompileDictIncrCmd( code = TclGetIntFromObj(NULL, intObj, &incrAmount); TclDecrRefCount(intObj); if (code != TCL_OK) { - return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr); + return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } } else { incrAmount = 1; @@ -1999,7 +2001,7 @@ TclCompileDictAppendCmd( tokenPtr = TokenAfter(parsePtr->tokenPtr); dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr); if (dictVarIndex < 0) { - return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr); + return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } /* @@ -2965,7 +2967,7 @@ CompileEachloopCmd( static void * DupForeachInfo( - void *clientData) /* The foreach command's compilation auxiliary + void *clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { ForeachInfo *srcPtr = (ForeachInfo *)clientData; @@ -3014,7 +3016,7 @@ DupForeachInfo( static void FreeForeachInfo( - void *clientData) /* The foreach command's compilation auxiliary + void *clientData) /* The foreach command's compilation auxiliary * data to free. */ { ForeachInfo *infoPtr = (ForeachInfo *)clientData; @@ -3348,7 +3350,7 @@ TclCompileFormatCmd( start = TclGetString(formatObj); /* The start of the currently-scanned literal * in the format string. */ - TclNewObj(tmpObj); /* The buffer used to accumulate the literal + TclNewObj(tmpObj); /* The buffer used to accumulate the literal * being built. */ for (bytes = start ; *bytes ; bytes++) { if (*bytes == '%') { @@ -3450,7 +3452,7 @@ TclLocalScalar( { Tcl_Token token[2] = { {TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, - {TCL_TOKEN_TEXT, NULL, 0, 0} + {TCL_TOKEN_TEXT, NULL, 0, 0} }; token[1].start = bytes; @@ -3598,34 +3600,35 @@ TclPushVarName( elNameLen = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1; if (!(flags & TCL_NO_ELEMENT)) { - if (remainingLen) { - /* - * Make a first token with the extra characters in the first - * token. - */ - - elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, n * sizeof(Tcl_Token)); - allocedTokens = 1; - elemTokenPtr->type = TCL_TOKEN_TEXT; - elemTokenPtr->start = elName; - elemTokenPtr->size = remainingLen; - elemTokenPtr->numComponents = 0; - elemTokenCount = n; - - /* - * Copy the remaining tokens. - */ - - memcpy(elemTokenPtr+1, varTokenPtr+2, - (n-1) * sizeof(Tcl_Token)); - } else { - /* - * Use the already available tokens. - */ - - elemTokenPtr = &varTokenPtr[2]; - elemTokenCount = n - 1; - } + if (remainingLen) { + /* + * Make a first token with the extra characters in the first + * token. + */ + + elemTokenPtr = (Tcl_Token *) + TclStackAlloc(interp, n * sizeof(Tcl_Token)); + allocedTokens = 1; + elemTokenPtr->type = TCL_TOKEN_TEXT; + elemTokenPtr->start = elName; + elemTokenPtr->size = remainingLen; + elemTokenPtr->numComponents = 0; + elemTokenCount = n; + + /* + * Copy the remaining tokens. + */ + + memcpy(elemTokenPtr + 1, varTokenPtr + 2, + (n-1) * sizeof(Tcl_Token)); + } else { + /* + * Use the already available tokens. + */ + + elemTokenPtr = &varTokenPtr[2]; + elemTokenCount = n - 1; + } } } } diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 8e44f96..6941afa 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -523,7 +523,7 @@ TclCompileIncrCmd( * Emit the instruction to increment the variable. */ - if (isScalar) { /* Simple scalar variable. */ + if (isScalar) { /* Simple scalar variable. */ if (localIndex >= 0) { if (haveImmValue) { TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr); @@ -2024,7 +2024,7 @@ TclCompileRegexpCmd( if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact, NULL) == TCL_OK) { simple = 1; - PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); + PushLiteral(envPtr, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); } } @@ -2208,7 +2208,8 @@ TclCompileRegsubCmd( isSimpleGlob: for (bytes = TclGetString(replacementObj); *bytes; bytes++) { switch (*bytes) { - case '\\': case '&': + case '\\': + case '&': goto done; } } diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index bc37155..968cc73 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -1129,66 +1129,66 @@ TclCompileStringReplaceCmd( } if (parsePtr->numWords == 5) { - /* - * When we have a string replacement, we have to take care about - * not replacing empty substrings that [string replace] promises - * not to replace - * - * The remaining index values might be suitable for conventional - * string replacement, but only if they cannot possibly meet the - * conditions described above at runtime. If there's a chance they - * might, we would have to emit bytecode to check and at that point - * we're paying more in bytecode execution time than would make - * things worthwhile. Trouble is we are very limited in - * how much we can detect that at compile time. After decoding, - * we need, first: - * - * (first <= end) - * - * The encoded indices (first <= TCL_INDEX END) and - * (first == TCL_INDEX_NONE) always meets this condition, but - * any other encoded first index has some list for which it fails. - * - * We also need, second: - * - * (last >= 0) - * - * The encoded index (last >= TCL_INDEX_START) always meet this - * condition but any other encoded last index has some list for - * which it fails. - * - * Finally we need, third: - * - * (first <= last) - * - * Considered in combination with the constraints we already have, - * we see that we can proceed when (first == TCL_INDEX_NONE). - * These also permit simplification of the prefix|replace|suffix - * construction. The other constraints, though, interfere with - * getting a guarantee that first <= last. - */ + /* + * When we have a string replacement, we have to take care about + * not replacing empty substrings that [string replace] promises + * not to replace + * + * The remaining index values might be suitable for conventional + * string replacement, but only if they cannot possibly meet the + * conditions described above at runtime. If there's a chance they + * might, we would have to emit bytecode to check and at that point + * we're paying more in bytecode execution time than would make + * things worthwhile. Trouble is we are very limited in + * how much we can detect that at compile time. After decoding, + * we need, first: + * + * (first <= end) + * + * The encoded indices (first <= TCL_INDEX END) and + * (first == TCL_INDEX_NONE) always meets this condition, but + * any other encoded first index has some list for which it fails. + * + * We also need, second: + * + * (last >= 0) + * + * The encoded index (last >= TCL_INDEX_START) always meet this + * condition but any other encoded last index has some list for + * which it fails. + * + * Finally we need, third: + * + * (first <= last) + * + * Considered in combination with the constraints we already have, + * we see that we can proceed when (first == TCL_INDEX_NONE). + * These also permit simplification of the prefix|replace|suffix + * construction. The other constraints, though, interfere with + * getting a guarantee that first <= last. + */ - if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) { - /* empty prefix */ - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 4); - OP4( REVERSE, 2); - if (last == INT_MAX) { - OP( POP); /* Pop original */ - } else { - OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END); - OP1( STR_CONCAT1, 2); + if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) { + /* empty prefix */ + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 4); + OP4( REVERSE, 2); + if (last == INT_MAX) { + OP( POP); /* Pop original */ + } else { + OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END); + OP1( STR_CONCAT1, 2); + } + return TCL_OK; } - return TCL_OK; - } - if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) { - OP44( STR_RANGE_IMM, 0, first-1); - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 4); - OP1( STR_CONCAT1, 2); - return TCL_OK; - } + if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) { + OP44( STR_RANGE_IMM, 0, first-1); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 4); + OP1( STR_CONCAT1, 2); + return TCL_OK; + } /* FLOW THROUGH TO genericReplace */ @@ -1474,12 +1474,12 @@ TclCompileSubstCmd( wordTokenPtr = TokenAfter(wordTokenPtr); } -/* +#if 0 if (TclSubstOptions(NULL, numOpts, objv, &flags) == TCL_OK) { toSubst = objv[numOpts]; Tcl_IncrRefCount(toSubst); } -*/ +#endif /* TODO: Figure out expansion to cover WordKnownAtCompileTime * The difficulty is that WKACT makes a copy, and if TclSubstParse @@ -2115,7 +2115,7 @@ IssueSwitchChainedTests( * switch can match against and bodies to * execute when the match succeeds. */ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */ - Tcl_Size *bodyLines, /* Array of line numbers for body list + Tcl_Size *bodyLines, /* Array of line numbers for body list * items. */ Tcl_Size **bodyContLines) /* Array of continuation line info. */ { @@ -2123,7 +2123,8 @@ IssueSwitchChainedTests( int foundDefault; /* Flag to indicate whether a "default" clause * is present. */ JumpFixup *fixupArray; /* Array of forward-jump fixup records. */ - unsigned int *fixupTargetArray; /* Array of places for fixups to point at. */ + unsigned int *fixupTargetArray; + /* Array of places for fixups to point at. */ int fixupCount; /* Number of places to fix up. */ int contFixIndex; /* Where the first of the jumps due to a group * of continuation bodies starts, or -1 if @@ -2363,7 +2364,7 @@ IssueSwitchJumpTable( * switch can match against and bodies to * execute when the match succeeds. */ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */ - Tcl_Size *bodyLines, /* Array of line numbers for body list + Tcl_Size *bodyLines, /* Array of line numbers for body list * items. */ Tcl_Size **bodyContLines) /* Array of continuation line info. */ { diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 5c46afd..5e36a86 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -746,7 +746,7 @@ ParseExpr( */ Tcl_ListObjAppendElement(NULL, funcList, literal); - } else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) { + } else if (Tcl_GetBooleanFromObj(NULL, literal, &b) == TCL_OK) { lexeme = BOOLEAN; } else { /* @@ -1869,8 +1869,8 @@ Tcl_ParseExpr( { int code; OpNode *opTree = NULL; /* Will point to the tree of operators. */ - Tcl_Obj *litList; /* List to hold the literals. */ - Tcl_Obj *funcList; /* List to hold the functon names. */ + Tcl_Obj *litList; /* List to hold the literals. */ + Tcl_Obj *funcList; /* List to hold the functon names. */ Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions. */ diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 38070b6..427ce3e 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -397,17 +397,17 @@ InstructionDesc const tclInstructionTable[] = { * stktop; op1 is 1 for errors on problems, 0 otherwise */ {"dictExpand", 1, -1, 0, {OPERAND_NONE}}, - /* Probe into a dict and extract it (or a subdict of it) into - * variables with matched names. Produces list of keys bound as - * result. Part of [dict with]. + /* Probe into a dict and extract it (or a subdict of it) into + * variables with matched names. Produces list of keys bound as + * result. Part of [dict with]. * Stack: ... dict path => ... keyList */ {"dictRecombineStk", 1, -3, 0, {OPERAND_NONE}}, - /* Map variable contents back into a dictionary in a variable. Part of - * [dict with]. + /* Map variable contents back into a dictionary in a variable. Part of + * [dict with]. * Stack: ... dictVarName path keyList => ... */ {"dictRecombineImm", 5, -2, 1, {OPERAND_LVT4}}, - /* Map variable contents back into a dictionary in the local variable - * indicated by the LVT index. Part of [dict with]. + /* Map variable contents back into a dictionary in the local variable + * indicated by the LVT index. Part of [dict with]. * Stack: ... path keyList => ... */ {"dictExists", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* The top op4 words (min 1) are a key path into the dictionary just @@ -637,7 +637,7 @@ InstructionDesc const tclInstructionTable[] = { * Stack: ... varName list => ... listVarContents */ {"clockRead", 2, +1, 1, {OPERAND_UINT1}}, - /* Read clock out to the stack. Operand is which clock to read + /* Read clock out to the stack. Operand is which clock to read * 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds. * Stack: ... => ... time */ @@ -779,7 +779,7 @@ TclSetByteCodeFromAny( * compiled. Must not be NULL. */ Tcl_Obj *objPtr, /* The object to make a ByteCode object. */ CompileHookProc *hookProc, /* Procedure to invoke after compilation. */ - void *clientData) /* Hook procedure private data. */ + void *clientData) /* Hook procedure private data. */ { Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated @@ -996,7 +996,7 @@ DupByteCodeInternalRep( static void FreeByteCodeInternalRep( - Tcl_Obj *objPtr) /* Object whose internal rep to free. */ + Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; @@ -1046,7 +1046,7 @@ TclReleaseByteCode( static void CleanupByteCode( - ByteCode *codePtr) /* Points to the ByteCode to free. */ + ByteCode *codePtr) /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; Interp *iPtr = (Interp *) interp; @@ -1397,7 +1397,7 @@ CompileSubstObj( static void FreeSubstCodeInternalRep( - Tcl_Obj *objPtr) /* Object whose internal rep to free. */ + Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; @@ -1448,7 +1448,7 @@ void TclInitCompileEnv( Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ - CompileEnv *envPtr,/* Points to the CompileEnv structure to + CompileEnv *envPtr, /* Points to the CompileEnv structure to * initialize. */ const char *stringPtr, /* The source string to be compiled. */ size_t numBytes, /* Number of bytes in source string. */ @@ -2513,8 +2513,8 @@ TclCompileTokens( if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = (Tcl_Size *)Tcl_Realloc(clPosition, - maxNumCL * sizeof(Tcl_Size)); + clPosition = (Tcl_Size *) Tcl_Realloc(clPosition, + maxNumCL * sizeof(Tcl_Size)); } clPosition[numCL] = clPos; numCL ++; @@ -2649,7 +2649,7 @@ TclCompileCmdWord( Tcl_Interp *interp, /* Used for error and status reporting. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens for * a command word to compile inline. */ - size_t count1, /* Number of tokens to consider at tokenPtr. + size_t count1, /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { @@ -2827,7 +2827,7 @@ PreventCycle( * * NOTE: [Bugs 3392070, 3389764] We make a copy based completely * on the string value, and do not call Tcl_DuplicateObj() so we - * can be sure we do not have any lingering cycles hiding in + * can be sure we do not have any lingering cycles hiding in * the internalrep. */ Tcl_Size numBytes; @@ -3034,7 +3034,7 @@ TclInitByteCodeObj( Tcl_Size TclFindCompiledLocal( - const char *name, /* Points to first character of the name of a + const char *name, /* Points to first character of the name of a * scalar or array variable. If NULL, a * temporary var should be created. */ Tcl_Size nameBytes, /* Number of bytes in the name. */ @@ -3090,7 +3090,7 @@ TclFindCompiledLocal( char *localName = localPtr->name; if ((nameBytes == localPtr->nameLength) && - (strncmp(name,localName,nameBytes) == 0)) { + (strncmp(name, localName, nameBytes) == 0)) { return i; } } @@ -3213,7 +3213,7 @@ EnterCmdStartData( Tcl_Size cmdIndex, /* Index of the command whose start data is * being set. */ Tcl_Size srcOffset, /* Offset of first char of the command. */ - Tcl_Size codeOffset) /* Offset of first byte of command code. */ + Tcl_Size codeOffset) /* Offset of first byte of command code. */ { CmdLocation *cmdLocPtr; @@ -3291,8 +3291,8 @@ EnterCmdExtentData( * location information. */ Tcl_Size cmdIndex, /* Index of the command whose source and code * length data is being set. */ - Tcl_Size numSrcBytes, /* Number of command source chars. */ - Tcl_Size numCodeBytes) /* Offset of last byte of command code. */ + Tcl_Size numSrcBytes, /* Number of command source chars. */ + Tcl_Size numCodeBytes) /* Offset of last byte of command code. */ { CmdLocation *cmdLocPtr; @@ -3775,16 +3775,15 @@ TclFinalizeLoopExceptionRange( Tcl_Size TclCreateAuxData( - void *clientData, /* The compilation auxiliary data to store in + void *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 + CompileEnv *envPtr) /* Points to the CompileEnv for which a new * aux data structure is to be allocated. */ { Tcl_Size index; /* Index for the new AuxData structure. */ - AuxData *auxDataPtr; - /* Points to the new AuxData structure */ + AuxData *auxDataPtr; /* Points to the new AuxData structure */ index = envPtr->auxDataArrayNext; if (index >= envPtr->auxDataArrayEnd) { diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 18d5ed7..3d9028e 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -859,7 +859,7 @@ enum TclInstruction { #define MAX_INSTRUCTION_OPERANDS 2 typedef enum InstOperandType { - OPERAND_NONE, + OPERAND_NONE, /* No operand. */ OPERAND_INT1, /* One byte signed integer. */ OPERAND_INT4, /* Four byte signed integer. */ OPERAND_UINT1, /* One byte unsigned integer. */ @@ -1841,13 +1841,15 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *args do { \ if (tclDTraceDebugEnabled) { \ int _l, _t = 0; \ - if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \ + if (!tclDTraceDebugLog) { \ + TclDTraceOpenDebugLog(); \ + } \ fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", \ - strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \ + strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \ fprintf(tclDTraceDebugLog, " %.*s():%n", \ (_t < 18 ? 18 - _t : 0) + 18, __func__, &_l); _t += _l; \ fprintf(tclDTraceDebugLog, "%*s" p "%n", \ - (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \ + (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \ "", &_l); _t += _l; \ fprintf(tclDTraceDebugLog, "%*s" m "\n", \ (_t < 64 ? 64 - _t : 1), "", ##__VA_ARGS__); \ diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 9fb2fa7..4708903 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -391,7 +391,7 @@ GetConfigDict( static void ConfigDictDeleteProc( - void *clientData, /* Pointer to Tcl_Obj. */ + void *clientData, /* Pointer to Tcl_Obj. */ TCL_UNUSED(Tcl_Interp *)) { Tcl_DecrRefCount((Tcl_Obj *)clientData); diff --git a/generic/tclDate.h b/generic/tclDate.h index fea7cbd..a8f306a 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -103,26 +103,27 @@ typedef enum ClockLiteral { LIT__END } ClockLiteral; -#define CLOCK_LITERAL_ARRAY(litarr) static const char *const litarr[] = { \ - "", \ - "%a %b %d %H:%M:%S %Z %Y", \ - "system", "current", "C", \ - "BCE", "CE", \ - "dayOfMonth", "dayOfWeek", "dayOfYear", \ - "era", ":GMT", "gregorian", \ - "integer value too large to represent", \ - "iso8601Week", "iso8601Year", \ - "julianDay", "localSeconds", \ - "month", \ - "seconds", "tzName", "tzOffset", \ - "year", \ - "::tcl::clock::TZData", \ - "::tcl::clock::GetSystemTimeZone", \ - "::tcl::clock::SetupTimeZone", \ - "::tcl::clock::mcget", \ - "::tcl::clock::GetSystemLocale", "::tcl::clock::mclocale", \ - "::tcl::clock::LocalizeFormat" \ -} +#define CLOCK_LITERAL_ARRAY(litarr) \ + static const char *const litarr[] = { \ + "", \ + "%a %b %d %H:%M:%S %Z %Y", \ + "system", "current", "C", \ + "BCE", "CE", \ + "dayOfMonth", "dayOfWeek", "dayOfYear", \ + "era", ":GMT", "gregorian", \ + "integer value too large to represent", \ + "iso8601Week", "iso8601Year", \ + "julianDay", "localSeconds", \ + "month", \ + "seconds", "tzName", "tzOffset", \ + "year", \ + "::tcl::clock::TZData", \ + "::tcl::clock::GetSystemTimeZone", \ + "::tcl::clock::SetupTimeZone", \ + "::tcl::clock::mcget", \ + "::tcl::clock::GetSystemLocale", "::tcl::clock::mclocale", \ + "::tcl::clock::LocalizeFormat" \ + } /* * Enumeration of the msgcat literals used in [clock] @@ -141,17 +142,18 @@ typedef enum ClockMsgCtLiteral { MCLIT__END } ClockMsgCtLiteral; -#define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) static const char *const litarr[] = { \ - pref "", \ - pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \ - pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", pref "DAYS_OF_WEEK_COMB", \ - pref "AM", pref "PM", \ - pref "LOCALE_ERAS", \ - pref "BCE", pref "CE", \ - pref "b.c.e.", pref "c.e.", \ - pref "b.c.", pref "a.d.", \ - pref "LOCALE_NUMERALS", \ -} +#define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) \ + static const char *const litarr[] = { \ + pref "", \ + pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \ + pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", pref "DAYS_OF_WEEK_COMB", \ + pref "AM", pref "PM", \ + pref "LOCALE_ERAS", \ + pref "BCE", pref "CE", \ + pref "b.c.e.", pref "c.e.", \ + pref "b.c.", pref "a.d.", \ + pref "LOCALE_NUMERALS", \ + } /* * Structure containing the fields used in [clock format] and [clock scan] @@ -486,8 +488,9 @@ struct ClockFmtScnStorage { #endif size_t fmtMinAlloc; #if 0 - Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry, - * stored by offset +sizeof(self) */ + Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of + * Tcl_HashEntry, stored by + * offset +sizeof(self) */ #endif }; diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 8c34bb8..ca86ed8 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -150,19 +150,19 @@ const Tcl_ObjType tclDictType = { TCL_OBJTYPE_V0 }; -#define DictSetInternalRep(objPtr, dictRepPtr) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.twoPtrValue.ptr1 = (dictRepPtr); \ - ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &tclDictType, &ir); \ +#define DictSetInternalRep(objPtr, dictRepPtr) \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.twoPtrValue.ptr1 = (dictRepPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreInternalRep((objPtr), &tclDictType, &ir); \ } while (0) -#define DictGetInternalRep(objPtr, dictRepPtr) \ - do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &tclDictType); \ - (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL; \ +#define DictGetInternalRep(objPtr, dictRepPtr) \ + do { \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &tclDictType); \ + (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -177,7 +177,7 @@ const Tcl_ObjType tclDictType = { static const Tcl_HashKeyType chainHashType = { TCL_HASH_KEY_TYPE_VERSION, - TCL_HASH_KEY_DIRECT_COMPARE, /* allows compare keys by pointers */ + TCL_HASH_KEY_DIRECT_COMPARE, /* allows compare keys by pointers */ TclHashObjKey, TclCompareObjKeys, AllocChainEntry, @@ -1264,7 +1264,7 @@ Tcl_DictObjNext( void Tcl_DictObjDone( - Tcl_DictSearch *searchPtr) /* Pointer to a hash search context. */ + Tcl_DictSearch *searchPtr) /* Pointer to a hash search context. */ { Dict *dict; @@ -1316,7 +1316,7 @@ Tcl_DictObjPutKeyList( Tcl_Panic("%s called with empty key list", "Tcl_DictObjPutKeyList"); } - dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE); + dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_CREATE); if (dictPtr == NULL) { return TCL_ERROR; } @@ -1374,7 +1374,7 @@ Tcl_DictObjRemoveKeyList( Tcl_Panic("%s called with empty key list", "Tcl_DictObjRemoveKeyList"); } - dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE); + dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_UPDATE); if (dictPtr == NULL) { return TCL_ERROR; } @@ -1612,7 +1612,7 @@ DictGetCmd( * Note that this loop always executes at least once. */ - dictPtr = TclTraceDictPath(interp, objv[1], objc-3,objv+2, DICT_PATH_READ); + dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2, DICT_PATH_READ); if (dictPtr == NULL) { return TCL_ERROR; } @@ -2005,7 +2005,7 @@ DictValuesCmd( } listPtr = Tcl_NewListObj(0, NULL); for (; !done ; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) { - if (pattern==NULL || Tcl_StringMatch(TclGetString(valuePtr),pattern)) { + if (pattern==NULL || Tcl_StringMatch(TclGetString(valuePtr), pattern)) { /* * Assume this operation always succeeds. */ @@ -2144,7 +2144,7 @@ DictExistsCmd( return TCL_ERROR; } - dictPtr = TclTraceDictPath(NULL, objv[1], objc-3, objv+2,DICT_PATH_EXISTS); + dictPtr = TclTraceDictPath(NULL, objv[1], objc-3, objv+2, DICT_PATH_EXISTS); if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT || Tcl_DictObjGet(NULL, dictPtr, objv[objc-1], &valuePtr) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); @@ -2809,7 +2809,7 @@ DictMapNRCmd( * Run the script. */ - TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); + TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, storagePtr->scriptObj, 0, iPtr->cmdFramePtr, 3); @@ -2899,7 +2899,7 @@ DictMapLoopCallback( * Run the script. */ - TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); + TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, storagePtr->scriptObj, 0, iPtr->cmdFramePtr, 3); @@ -3080,7 +3080,7 @@ DictFilterCmd( return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType", - 0, &index) != TCL_OK) { + 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -3390,7 +3390,7 @@ DictUpdateCmd( objPtr = Tcl_NewListObj(objc-3, objv+2); Tcl_IncrRefCount(objPtr); Tcl_IncrRefCount(objv[1]); - TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL); + TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL, NULL); return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1); } diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 5a64ff8..1d2436c 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -557,56 +557,69 @@ FormatInstruction( for (i = 0; i < instDesc->numOperands; i++) { switch (instDesc->opTypes[i]) { case OPERAND_INT1: - opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++; + opnd = TclGetInt1AtPtr(pc+numBytes); + numBytes++; Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_INT4: - opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; + opnd = TclGetInt4AtPtr(pc+numBytes); + numBytes += 4; Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_UINT1: - opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; + opnd = TclGetUInt1AtPtr(pc+numBytes); + numBytes++; Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_UINT4: - opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; + opnd = TclGetUInt4AtPtr(pc+numBytes); + numBytes += 4; if (opCode == INST_START_CMD) { - snprintf(suffixBuffer+strlen(suffixBuffer), sizeof(suffixBuffer) - strlen(suffixBuffer), + snprintf(suffixBuffer+strlen(suffixBuffer), + sizeof(suffixBuffer) - strlen(suffixBuffer), ", %u cmds start here", opnd); } Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_OFFSET1: - opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++; + opnd = TclGetInt1AtPtr(pc+numBytes); + numBytes++; snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd); Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_OFFSET4: - opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; + opnd = TclGetInt4AtPtr(pc+numBytes); + numBytes += 4; if (opCode == INST_START_CMD) { - snprintf(suffixBuffer, sizeof(suffixBuffer), "next cmd at pc %u", pcOffset+opnd); + snprintf(suffixBuffer, sizeof(suffixBuffer), + "next cmd at pc %u", pcOffset+opnd); } else { - snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd); + snprintf(suffixBuffer, sizeof(suffixBuffer), + "pc %u", pcOffset+opnd); } Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_LIT1: - opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; + opnd = TclGetUInt1AtPtr(pc+numBytes); + numBytes++; suffixObj = codePtr->objArrayPtr[opnd]; Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_LIT4: - opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; + opnd = TclGetUInt4AtPtr(pc+numBytes); + numBytes += 4; suffixObj = codePtr->objArrayPtr[opnd]; Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_AUX4: - opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; + opnd = TclGetUInt4AtPtr(pc+numBytes); + numBytes += 4; Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); auxPtr = &codePtr->auxDataArrayPtr[opnd]; break; case OPERAND_IDX4: - opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; + opnd = TclGetInt4AtPtr(pc+numBytes); + numBytes += 4; if (opnd >= -1) { Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd); } else if (opnd == -2) { @@ -625,14 +638,16 @@ FormatInstruction( printLVTindex: if (localPtr != NULL) { if (opnd >= localCt) { - Tcl_Panic("FormatInstruction: bad local var index %u (%" TCL_SIZE_MODIFIER "d locals)", + Tcl_Panic("FormatInstruction: bad local var index %u (%" + TCL_SIZE_MODIFIER "d locals)", opnd, localCt); } for (j = 0; j < opnd; j++) { localPtr = localPtr->nextPtr; } if (TclIsVarTemporary(localPtr)) { - snprintf(suffixBuffer, sizeof(suffixBuffer), "temp var %u", opnd); + snprintf(suffixBuffer, sizeof(suffixBuffer), + "temp var %u", opnd); } else { snprintf(suffixBuffer, sizeof(suffixBuffer), "var "); suffixSrc = localPtr->name; @@ -641,7 +656,8 @@ FormatInstruction( Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", opnd); break; case OPERAND_SCLS1: - opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; + opnd = TclGetUInt1AtPtr(pc+numBytes); + numBytes++; Tcl_AppendPrintfToObj(bufferObj, "%s ", tclStringClassTable[opnd].name); break; @@ -703,8 +719,8 @@ TclGetInnerContext( case INST_TRY_CVT_TO_NUMERIC: case INST_EXPAND_STKTOP: case INST_EXPR_STK: - objc = 1; - break; + objc = 1; + break; case INST_LIST_IN: case INST_LIST_NOT_IN: /* Basic list containment operators. */ @@ -731,22 +747,22 @@ TclGetInnerContext( case INST_SUB: case INST_DIV: case INST_MULT: - objc = 2; - break; + objc = 2; + break; case INST_RETURN_STK: - /* early pop. TODO: dig out opt dict too :/ */ - objc = 1; - break; + /* early pop. TODO: dig out opt dict too :/ */ + objc = 1; + break; case INST_SYNTAX: case INST_RETURN_IMM: - objc = 2; - break; + objc = 2; + break; case INST_INVOKE_STK4: objc = TclGetUInt4AtPtr(pc+1); - break; + break; case INST_INVOKE_STK1: objc = TclGetUInt1AtPtr(pc+1); @@ -755,37 +771,37 @@ TclGetInnerContext( result = iPtr->innerContext; if (Tcl_IsShared(result)) { - Tcl_DecrRefCount(result); - iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL); - Tcl_IncrRefCount(result); + Tcl_DecrRefCount(result); + iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL); + Tcl_IncrRefCount(result); } else { - Tcl_Size len; + Tcl_Size len; - /* - * Reset while keeping the list internalrep as much as possible. - */ + /* + * Reset while keeping the list internalrep as much as possible. + */ TclListObjLength(interp, result, &len); - Tcl_ListObjReplace(interp, result, 0, len, 0, NULL); + Tcl_ListObjReplace(interp, result, 0, len, 0, NULL); } Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc)); for (; objc>0 ; objc--) { - Tcl_Obj *objPtr; + Tcl_Obj *objPtr; - objPtr = tosPtr[1 - objc]; - if (!objPtr) { - Tcl_Panic("InnerContext: bad tos -- appending null object"); - } - if ((objPtr->refCount <= 0) + objPtr = tosPtr[1 - objc]; + if (!objPtr) { + Tcl_Panic("InnerContext: bad tos -- appending null object"); + } + if ((objPtr->refCount <= 0) #ifdef TCL_MEM_DEBUG - || (objPtr->refCount == 0x61616161) + || (objPtr->refCount == 0x61616161) #endif - ) { - Tcl_Panic("InnerContext: bad tos -- appending freed object %p", - objPtr); - } - Tcl_ListObjAppendElement(NULL, result, objPtr); + ) { + Tcl_Panic("InnerContext: bad tos -- appending freed object %p", + objPtr); + } + Tcl_ListObjAppendElement(NULL, result, objPtr); } return result; @@ -828,7 +844,7 @@ static void UpdateStringOfInstName( Tcl_Obj *objPtr) { - size_t inst; /* NOTE: We know this is really an unsigned char */ + size_t inst; /* NOTE: We know this is really an unsigned char */ char *dst; InstNameGetInternalRep(objPtr, inst); @@ -836,7 +852,7 @@ UpdateStringOfInstName( if (inst >= LAST_INST_OPCODE) { dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); TclOOM(dst, TCL_INTEGER_SPACE + 5); - snprintf(dst, TCL_INTEGER_SPACE + 5, "inst_%" TCL_Z_MODIFIER "u", inst); + snprintf(dst, TCL_INTEGER_SPACE + 5, "inst_%" TCL_Z_MODIFIER "u", inst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { const char *s = tclInstructionTable[inst].name; @@ -1171,8 +1187,8 @@ DisassembleByteCodeAsDicts( #define Decode(ptr) \ ((TclGetUInt1AtPtr(ptr) == 0xFF) \ - ? ((ptr)+=5 , TclGetInt4AtPtr((ptr)-4)) \ - : ((ptr)+=1 , TclGetInt1AtPtr((ptr)-1))) + ? ((ptr)+=5, TclGetInt4AtPtr((ptr)-4)) \ + : ((ptr)+=1, TclGetInt1AtPtr((ptr)-1))) TclNewObj(commands); codeOffPtr = codePtr->codeDeltaStart; @@ -1268,7 +1284,7 @@ DisassembleByteCodeAsDicts( int Tcl_DisassembleObjCmd( - void *clientData, /* What type of operation. */ + void *clientData, /* What type of operation. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 0844303..438a643 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -34,9 +34,9 @@ typedef struct { Tcl_EncodingFreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ - void *clientData; /* Arbitrary value associated with encoding + void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ - Tcl_Size nullSize; /* Number of 0x00 bytes that signify + Tcl_Size nullSize; /* Number of 0x00 bytes that signify * end-of-string in this encoding. This number * is used to determine the source string * length when the srcLen argument is @@ -201,19 +201,19 @@ static const struct TclEncodingProfiles { {"tcl8", TCL_ENCODING_PROFILE_TCL8}, }; -#define PROFILE_TCL8(flags_) \ - (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8) +#define PROFILE_TCL8(flags) \ + (ENCODING_PROFILE_GET(flags) == TCL_ENCODING_PROFILE_TCL8) -#define PROFILE_REPLACE(flags_) \ - (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) +#define PROFILE_REPLACE(flags) \ + (ENCODING_PROFILE_GET(flags) == TCL_ENCODING_PROFILE_REPLACE) -#define PROFILE_STRICT(flags_) \ - (!PROFILE_TCL8(flags_) && !PROFILE_REPLACE(flags_)) +#define PROFILE_STRICT(flags) \ + (!PROFILE_TCL8(flags) && !PROFILE_REPLACE(flags)) #define UNICODE_REPLACE_CHAR 0xFFFD -#define SURROGATE(c_) (((c_) & ~0x7FF) == 0xD800) -#define HIGH_SURROGATE(c_) (((c_) & ~0x3FF) == 0xD800) -#define LOW_SURROGATE(c_) (((c_) & ~0x3FF) == 0xDC00) +#define SURROGATE(chr) (((chr) & ~0x7FF) == 0xD800) +#define HIGH_SURROGATE(chr) (((chr) & ~0x3FF) == 0xD800) +#define LOW_SURROGATE(chr) (((chr) & ~0x3FF) == 0xDC00) /* * The following variable is used in the sparse matrix code for a @@ -924,7 +924,7 @@ Tcl_GetEncodingNames( * Tcl_GetEncodingNulLength -- * * Given an encoding, return the number of nul bytes used for the - * string termination. + * string termination. * * Results: * The number of nul bytes used for the string termination. @@ -1124,34 +1124,35 @@ Tcl_ExternalToUtfDString( * - *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT} * * Results: - * The return value is one of - * TCL_OK: success. Converted string in *dstPtr - * TCL_ERROR: error in passed parameters. Error message in interp - * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence - * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition - * TCL_CONVERT_UNKNOWN: source contained a character that could not - * be represented in target encoding. + * The return value is one of: + * + * TCL_OK: success. Converted string in *dstPtr + * TCL_ERROR: error in passed parameters. Error message in interp + * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence + * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition + * TCL_CONVERT_UNKNOWN: source contained a character that could not + * be represented in target encoding. * * Side effects: * - * TCL_OK: The converted bytes are stored in the DString and NUL - * terminated in an encoding-specific manner. - * TCL_ERROR: an error, message is stored in the interp if not NULL. - * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored - * in the interpreter (if not NULL). If errorLocPtr is not NULL, - * no error message is stored as it is expected the caller is - * interested in whatever is decoded so far and not treating this - * as an error condition. + * TCL_OK: The converted bytes are stored in the DString and NUL + * terminated in an encoding-specific manner. + * TCL_ERROR: an error, message is stored in the interp if not NULL. + * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored + * in the interpreter (if not NULL). If errorLocPtr is not NULL, + * no error message is stored as it is expected the caller is + * interested in whatever is decoded so far and not treating this + * as an error condition. * - * In addition, *dstPtr is always initialized and must be cleared - * by the caller irrespective of the return code. + * In addition, *dstPtr is always initialized and must be cleared + * by the caller irrespective of the return code. * *------------------------------------------------------------------------- */ int Tcl_ExternalToUtfDStringEx( - Tcl_Interp *interp, /* For error messages. May be NULL. */ + Tcl_Interp *interp, /* For error messages. May be NULL. */ Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ @@ -1160,8 +1161,8 @@ Tcl_ExternalToUtfDStringEx( int flags, /* Conversion control flags. */ Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ - Tcl_Size *errorLocPtr) /* Where to store the error location - * (or TCL_INDEX_NONE if no error). May + Tcl_Size *errorLocPtr) /* Where to store the error location + * (or TCL_INDEX_NONE if no error). May * be NULL. */ { char *dst; @@ -1440,34 +1441,35 @@ Tcl_UtfToExternalDString( * - *At most one* of TCL_ENCODING_PROFILE_* * * Results: - * The return value is one of - * TCL_OK: success. Converted string in *dstPtr - * TCL_ERROR: error in passed parameters. Error message in interp - * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence - * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition - * TCL_CONVERT_UNKNOWN: source contained a character that could not - * be represented in target encoding. + * The return value is one of: + * + * TCL_OK: success. Converted string in *dstPtr + * TCL_ERROR: error in passed parameters. Error message in interp + * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence + * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition + * TCL_CONVERT_UNKNOWN: source contained a character that could not + * be represented in target encoding. * * Side effects: * - * TCL_OK: The converted bytes are stored in the DString and NUL - * terminated in an encoding-specific manner - * TCL_ERROR: an error, message is stored in the interp if not NULL. - * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored - * in the interpreter (if not NULL). If errorLocPtr is not NULL, - * no error message is stored as it is expected the caller is - * interested in whatever is decoded so far and not treating this - * as an error condition. + * TCL_OK: The converted bytes are stored in the DString and NUL + * terminated in an encoding-specific manner + * TCL_ERROR: an error, message is stored in the interp if not NULL. + * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored + * in the interpreter (if not NULL). If errorLocPtr is not NULL, + * no error message is stored as it is expected the caller is + * interested in whatever is decoded so far and not treating this + * as an error condition. * - * In addition, *dstPtr is always initialized and must be cleared - * by the caller irrespective of the return code. + * In addition, *dstPtr is always initialized and must be cleared + * by the caller irrespective of the return code. * *------------------------------------------------------------------------- */ int Tcl_UtfToExternalDStringEx( - Tcl_Interp *interp, /* For error messages. May be NULL. */ + Tcl_Interp *interp, /* For error messages. May be NULL. */ Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ @@ -1476,8 +1478,8 @@ Tcl_UtfToExternalDStringEx( int flags, /* Conversion control flags. */ Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ - Tcl_Size *errorLocPtr) /* Where to store the error location - * (or TCL_INDEX_NONE if no error). May + Tcl_Size *errorLocPtr) /* Where to store the error location + * (or TCL_INDEX_NONE if no error). May * be NULL. */ { char *dst; @@ -2458,7 +2460,6 @@ UtfToUtfProc( profile = ENCODING_PROFILE_GET(flags); for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { - if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the @@ -2472,7 +2473,8 @@ UtfToUtfProc( result = TCL_CONVERT_NOSPACE; break; } - if (UCHAR(*src) < 0x80 && !((UCHAR(*src) == 0) && (flags & ENCODING_INPUT))) { + if (UCHAR(*src) < 0x80 + && !((UCHAR(*src) == 0) && (flags & ENCODING_INPUT))) { /* * Copy 7bit characters, but skip null-bytes when we are in input * mode, so that they get converted to \xC0\x80. @@ -2513,8 +2515,8 @@ UtfToUtfProc( /* Incomplete bytes for modified UTF-8 target */ if (PROFILE_STRICT(profile)) { result = (flags & TCL_ENCODING_CHAR_LIMIT) - ? TCL_CONVERT_MULTIBYTE - : TCL_CONVERT_SYNTAX; + ? TCL_CONVERT_MULTIBYTE + : TCL_CONVERT_SYNTAX; break; } } @@ -2524,14 +2526,16 @@ UtfToUtfProc( } else { /* TCL_ENCODING_PROFILE_TCL8 */ char chbuf[2]; - chbuf[0] = UCHAR(*src++); chbuf[1] = 0; + chbuf[0] = UCHAR(*src++); + chbuf[1] = 0; TclUtfToUniChar(chbuf, &ch); } dst += Tcl_UniCharToUtf(ch, dst); } else { size_t len = TclUtfToUniChar(src, &ch); if (flags & ENCODING_INPUT) { - if (((len < 2) && (ch != 0)) || ((ch > 0xFFFF) && !(flags & ENCODING_UTF))) { + if (((len < 2) && (ch != 0)) + || ((ch > 0xFFFF) && !(flags & ENCODING_UTF))) { if (PROFILE_STRICT(profile)) { result = TCL_CONVERT_SYNTAX; break; @@ -2543,7 +2547,8 @@ UtfToUtfProc( const char *saveSrc = src; src += len; - if (!(flags & ENCODING_UTF) && !(flags & ENCODING_INPUT) && (ch > 0x3FF)) { + if (!(flags & ENCODING_UTF) + && !(flags & ENCODING_INPUT) && (ch > 0x3FF)) { if (ch > 0xFFFF) { /* CESU-8 6-byte sequence for chars > U+FFFF */ ch -= 0x10000; @@ -2558,7 +2563,9 @@ UtfToUtfProc( continue; } else if (SURROGATE(ch)) { if (PROFILE_STRICT(profile)) { - result = (flags & ENCODING_INPUT) ? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN; + result = (flags & ENCODING_INPUT) + ? TCL_CONVERT_SYNTAX + : TCL_CONVERT_UNKNOWN; src = saveSrc; break; } else if (PROFILE_REPLACE(profile)) { @@ -2593,7 +2600,7 @@ UtfToUtfProc( static int Utf32ToUtfProc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in Unicode. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -2722,7 +2729,7 @@ Utf32ToUtfProc( static int UtfToUtf32Proc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -2821,7 +2828,7 @@ UtfToUtf32Proc( static int Utf16ToUtfProc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in Unicode. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -2894,8 +2901,8 @@ Utf16ToUtfProc( if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) { if (PROFILE_STRICT(flags)) { result = TCL_CONVERT_SYNTAX; - src -= 2; /* Go back to beginning of high surrogate */ - dst--; /* Also undo writing a single byte too much */ + src -= 2; /* Go back to beginning of high surrogate */ + dst--; /* Also undo writing a single byte too much */ numChars--; break; } else if (PROFILE_REPLACE(flags)) { @@ -2912,7 +2919,8 @@ Utf16ToUtfProc( numChars--; continue; } else { - /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */ + /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo + * surrogate, finish 3-byte UTF-8 */ dst += Tcl_UniCharToUtf(-1, dst); } } @@ -2999,7 +3007,7 @@ Utf16ToUtfProc( static int UtfToUtf16Proc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -3107,7 +3115,7 @@ UtfToUtf16Proc( static int UtfToUcs2Proc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -3211,7 +3219,7 @@ UtfToUcs2Proc( static int TableToUtfProc( - void *clientData, /* TableEncodingData that specifies + void *clientData, /* TableEncodingData that specifies * encoding. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ @@ -3296,7 +3304,8 @@ TableToUtfProc( ch = UNICODE_REPLACE_CHAR; } else { char chbuf[2]; - chbuf[0] = byte; chbuf[1] = 0; + chbuf[0] = byte; + chbuf[1] = 0; TclUtfToUniChar(chbuf, &ch); } } @@ -3339,7 +3348,7 @@ TableToUtfProc( static int TableFromUtfProc( - void *clientData, /* TableEncodingData that specifies + void *clientData, /* TableEncodingData that specifies * encoding. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ @@ -3631,7 +3640,7 @@ Iso88591FromUtfProc( static void TableFreeProc( - void *clientData) /* TableEncodingData that specifies + void *clientData) /* TableEncodingData that specifies * encoding. */ { TableEncodingData *dataPtr = (TableEncodingData *)clientData; @@ -3666,7 +3675,7 @@ TableFreeProc( static int EscapeToUtfProc( - void *clientData, /* EscapeEncodingData that specifies + void *clientData, /* EscapeEncodingData that specifies * encoding. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ @@ -3879,7 +3888,7 @@ EscapeToUtfProc( static int EscapeFromUtfProc( - void *clientData, /* EscapeEncodingData that specifies + void *clientData, /* EscapeEncodingData that specifies * encoding. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ @@ -4090,7 +4099,7 @@ EscapeFromUtfProc( static void EscapeFreeProc( - void *clientData) /* EscapeEncodingData that specifies + void *clientData) /* EscapeEncodingData that specifies * encoding. */ { EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData; diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 1ff0921..94dca96 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -85,7 +85,7 @@ static const Tcl_ObjType ensembleCmdType = { TCL_OBJTYPE_V0 }; -#define ECRSetInternalRep(objPtr, ecRepPtr) \ +#define ECRSetInternalRep(objPtr, ecRepPtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (ecRepPtr); \ @@ -93,11 +93,11 @@ static const Tcl_ObjType ensembleCmdType = { Tcl_StoreInternalRep((objPtr), &ensembleCmdType, &ir); \ } while (0) -#define ECRGetInternalRep(objPtr, ecRepPtr) \ +#define ECRGetInternalRep(objPtr, ecRepPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &ensembleCmdType); \ - (ecRepPtr) = irPtr ? (EnsembleCmdRep *)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &ensembleCmdType); \ + (ecRepPtr) = irPtr ? (EnsembleCmdRep *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -106,14 +106,14 @@ static const Tcl_ObjType ensembleCmdType = { */ typedef struct { - Tcl_Size epoch; /* Used to confirm when the data in this - * really structure matches up with the - * ensemble. */ - Command *token; /* Reference to the command for which this - * structure is a cache of the resolution. */ - Tcl_Obj *fix; /* Corrected spelling, if needed. */ - Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash - * table. */ + Tcl_Size epoch; /* Used to confirm when the data in this + * really structure matches up with the + * ensemble. */ + Command *token; /* Reference to the command for which this + * structure is a cache of the resolution. */ + Tcl_Obj *fix; /* Corrected spelling, if needed. */ + Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash + * table. */ } EnsembleCmdRep; static inline Tcl_Obj * @@ -529,7 +529,7 @@ TclNamespaceEnsembleCmd( for (; objc>0 ; objc-=2,objv+=2) { enum EnsConfigOpts idx; - if (Tcl_GetIndexFromObj(interp, objv[0],ensembleConfigOptions, + if (Tcl_GetIndexFromObj(interp, objv[0], ensembleConfigOptions, "option", 0, &idx) != TCL_OK) { freeMapAndError: if (allocatedMapFlag) { @@ -2484,15 +2484,15 @@ ClearTable( Tcl_HashTable *hash = &ensemblePtr->subcommandTable; if (hash->numEntries != 0) { - Tcl_HashSearch search; - Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search); + Tcl_HashSearch search; + Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search); - while (hPtr != NULL) { - Tcl_Obj *prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(prefixObj); - hPtr = Tcl_NextHashEntry(&search); - } - Tcl_Free(ensemblePtr->subcommandArrayPtr); + while (hPtr != NULL) { + Tcl_Obj *prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); + Tcl_DecrRefCount(prefixObj); + hPtr = Tcl_NextHashEntry(&search); + } + Tcl_Free(ensemblePtr->subcommandArrayPtr); } Tcl_DeleteHashTable(hash); } @@ -2595,100 +2595,100 @@ BuildEnsembleConfig( Tcl_InitHashTable(hash, TCL_STRING_KEYS); if (subList) { - Tcl_Size subc; - Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; - const char *name; - - /* - * There is a list of exactly what subcommands go in the table. - * Determine the target for each. - */ - - TclListObjGetElements(NULL, subList, &subc, &subv); - if (subList == mapDict) { - /* - * Unusual case where explicit list of subcommands is same value - * as the dict mapping to targets. - */ - - for (i = 0; i < subc; i += 2) { - name = TclGetString(subv[i]); - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - if (!isNew) { - cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(cmdObj); - } - Tcl_SetHashValue(hPtr, subv[i+1]); - Tcl_IncrRefCount(subv[i+1]); - - name = TclGetString(subv[i+1]); - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - if (isNew) { - cmdObj = Tcl_NewStringObj(name, -1); - cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); - Tcl_SetHashValue(hPtr, cmdPrefixObj); - Tcl_IncrRefCount(cmdPrefixObj); - } - } - } else { - /* + Tcl_Size subc; + Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; + const char *name; + + /* + * There is a list of exactly what subcommands go in the table. + * Determine the target for each. + */ + + TclListObjGetElements(NULL, subList, &subc, &subv); + if (subList == mapDict) { + /* + * Unusual case where explicit list of subcommands is same value + * as the dict mapping to targets. + */ + + for (i = 0; i < subc; i += 2) { + name = TclGetString(subv[i]); + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + if (!isNew) { + cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); + Tcl_DecrRefCount(cmdObj); + } + Tcl_SetHashValue(hPtr, subv[i+1]); + Tcl_IncrRefCount(subv[i+1]); + + name = TclGetString(subv[i+1]); + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + if (isNew) { + cmdObj = Tcl_NewStringObj(name, -1); + cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); + Tcl_SetHashValue(hPtr, cmdPrefixObj); + Tcl_IncrRefCount(cmdPrefixObj); + } + } + } else { + /* * Usual case where we can freely act on the list and dict. */ - for (i = 0; i < subc; i++) { - name = TclGetString(subv[i]); - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - if (!isNew) { - continue; - } + for (i = 0; i < subc; i++) { + name = TclGetString(subv[i]); + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + if (!isNew) { + continue; + } - /* + /* * Lookup target in the dictionary. */ - if (mapDict) { - Tcl_DictObjGet(NULL, mapDict, subv[i], &target); - if (target) { - Tcl_SetHashValue(hPtr, target); - Tcl_IncrRefCount(target); - continue; - } - } - - /* - * Target was not in the dictionary. Map onto the namespace. - * In this case there is no guarantee that the command - * is actually there. It is the responsibility of the + if (mapDict) { + Tcl_DictObjGet(NULL, mapDict, subv[i], &target); + if (target) { + Tcl_SetHashValue(hPtr, target); + Tcl_IncrRefCount(target); + continue; + } + } + + /* + * Target was not in the dictionary. Map onto the namespace. + * In this case there is no guarantee that the command + * is actually there. It is the responsibility of the * programmer (or [::unknown] of course) to provide the procedure. - */ - - cmdObj = Tcl_NewStringObj(name, -1); - cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); - Tcl_SetHashValue(hPtr, cmdPrefixObj); - Tcl_IncrRefCount(cmdPrefixObj); - } - } + */ + + cmdObj = Tcl_NewStringObj(name, -1); + cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); + Tcl_SetHashValue(hPtr, cmdPrefixObj); + Tcl_IncrRefCount(cmdPrefixObj); + } + } } else if (mapDict) { - /* - * No subcmd list, but there is a mapping dictionary, so - * use the keys of that. Convert the contents of the dictionary into the - * form required for the internal hashtable of the ensemble. - */ - - Tcl_DictSearch dictSearch; - Tcl_Obj *keyObj, *valueObj; - int done; - - Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, - &keyObj, &valueObj, &done); - while (!done) { - const char *name = TclGetString(keyObj); - - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - Tcl_SetHashValue(hPtr, valueObj); - Tcl_IncrRefCount(valueObj); - Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done); - } + /* + * No subcmd list, but there is a mapping dictionary, so + * use the keys of that. Convert the contents of the dictionary into the + * form required for the internal hashtable of the ensemble. + */ + + Tcl_DictSearch dictSearch; + Tcl_Obj *keyObj, *valueObj; + int done; + + Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, + &keyObj, &valueObj, &done); + while (!done) { + const char *name = TclGetString(keyObj); + + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + Tcl_SetHashValue(hPtr, valueObj); + Tcl_IncrRefCount(valueObj); + Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done); + } } else { /* * Use the array of patterns and the hash table whose keys are the @@ -3011,7 +3011,7 @@ TclCompileEnsemble( * Exact match! Excellent! */ - result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj); + result = Tcl_DictObjGet(NULL, mapObj, elems[i], &targetCmdObj); if (result != TCL_OK || targetCmdObj == NULL) { goto tryCompileToInv; } @@ -3193,9 +3193,9 @@ TclCompileEnsemble( */ while (mapPtr->nuloc > eclIndex + 1) { - mapPtr->nuloc--; - Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); - mapPtr->loc[mapPtr->nuloc].line = NULL; + mapPtr->nuloc--; + Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); + mapPtr->loc[mapPtr->nuloc].line = NULL; } /* @@ -3451,7 +3451,7 @@ CompileToInvokedCommand( * Do the replacing dispatch. */ - TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1); + TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords, numWords+1); } /* diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 0128672..4ef7b24 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -19,10 +19,13 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #if defined(_WIN32) # define tenviron _wenviron -# define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ - (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr))) -# define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ - (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr))) +# define tenviron2utfdstr(str, dsPtr) \ + (Tcl_DStringInit(dsPtr), \ + (char *)Tcl_Char16ToUtfDString( \ + (const unsigned short *)(str), -1, (dsPtr))) +# define utf2tenvirondstr(str, dsPtr) \ + (Tcl_DStringInit(dsPtr), \ + (const WCHAR *) Tcl_UtfToChar16DString((str), -1, (dsPtr))) # define techar WCHAR # ifdef USE_PUTENV # define putenv(env) _wputenv((const wchar_t *)env) @@ -37,7 +40,7 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #endif /* MODULE_SCOPE */ -size_t TclEnvEpoch = 0; /* Epoch of the tcl environment +size_t TclEnvEpoch = 0; /* Epoch of the tcl environment * (if changed with tcl-env). */ static struct { @@ -45,7 +48,7 @@ static struct { char **cache; /* Array containing all of the environment * strings that Tcl has allocated. */ #ifndef USE_PUTENV - techar **ourEnviron; /* Cache of the array that we allocate. We + techar **ourEnviron; /* Cache of the array that we allocate. We * need to track this in case another * subsystem swaps around the environ array * like we do. */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 29d8a0c..de475ea 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -69,7 +69,7 @@ typedef struct { typedef struct ExitHandler { Tcl_ExitProc *proc; /* Function to call when process exits. */ - void *clientData; /* One word of information to pass to proc. */ + void *clientData; /* One word of information to pass to proc. */ struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this * application, or NULL for end of list. */ } ExitHandler; @@ -119,7 +119,7 @@ static Tcl_ThreadDataKey dataKey; #if TCL_THREADS typedef struct { Tcl_ThreadCreateProc *proc; /* Main() function of the thread */ - void *clientData; /* The one argument to Main() */ + void *clientData; /* The one argument to Main() */ } ThreadClientData; static Tcl_ThreadCreateType NewThreadProc(void *clientData); #endif /* TCL_THREADS */ @@ -209,7 +209,7 @@ Tcl_BackgroundException( static void HandleBgErrors( - void *clientData) /* Pointer to ErrAssocData structure. */ + void *clientData) /* Pointer to ErrAssocData structure. */ { ErrAssocData *assocPtr = (ErrAssocData *)clientData; Tcl_Interp *interp = assocPtr->interp; @@ -613,7 +613,7 @@ TclGetBgErrorHandler( static void BgErrorDeleteProc( - void *clientData, /* Pointer to ErrAssocData structure. */ + void *clientData, /* Pointer to ErrAssocData structure. */ TCL_UNUSED(Tcl_Interp *)) { ErrAssocData *assocPtr = (ErrAssocData *)clientData; @@ -652,7 +652,7 @@ BgErrorDeleteProc( void Tcl_CreateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler)); @@ -685,7 +685,7 @@ Tcl_CreateExitHandler( void TclCreateLateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler)); @@ -718,7 +718,7 @@ TclCreateLateExitHandler( void Tcl_DeleteExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; @@ -761,7 +761,7 @@ Tcl_DeleteExitHandler( void TclDeleteLateExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; @@ -804,7 +804,7 @@ TclDeleteLateExitHandler( void Tcl_CreateThreadExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -837,7 +837,7 @@ Tcl_CreateThreadExitHandler( void Tcl_DeleteThreadExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -899,14 +899,14 @@ Tcl_SetExitProc( * * InvokeExitHandlers -- * - * Call the registered exit handlers. + * Call the registered exit handlers. * * Results: * None. * * Side effects: - * The exit handlers are invoked, and the ExitHandler struct is - * freed. + * The exit handlers are invoked, and the Exi tHandler struct is + * freed. * *---------------------------------------------------------------------- */ @@ -1132,14 +1132,13 @@ Tcl_InitSubsystems(void) TclpInitLock(); if (subsystemsInitialized == 0) { - - /* + /* * Initialize locks used by the memory allocators before anything * interesting happens so we can use the allocators in the * implementation of self-initializing locks. */ - TclInitThreadStorage(); /* Creates hash table for + TclInitThreadStorage(); /* Creates hash table for * thread local storage */ #if defined(USE_TCLALLOC) && USE_TCLALLOC TclInitAlloc(); /* Process wide mutex init */ @@ -2052,7 +2051,7 @@ Tcl_CreateThread( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ void *clientData, /* The one argument to Main() */ - size_t stackSize, /* Size of stack for the new thread */ + size_t stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index c94e570..ccbd953 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -192,7 +192,7 @@ VarHashCreateVar( /* Verify the stack depth, only when no expansion is in progress */ #ifdef TCL_COMPILE_DEBUG -#define CHECK_STACK() \ +#define CHECK_STACK() \ do { \ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \ /*checkStack*/ !(starting || auxObjList)); \ @@ -202,53 +202,53 @@ VarHashCreateVar( #define CHECK_STACK() #endif -#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ - do { \ - TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \ - CHECK_STACK(); \ - if (nCleanup == 0) { \ - if (resultHandling != 0) { \ - if ((resultHandling) > 0) { \ - PUSH_OBJECT(objResultPtr); \ - } else { \ - *(++tosPtr) = objResultPtr; \ - } \ - } \ - pc += (pcAdjustment); \ - goto cleanup0; \ - } else if (resultHandling != 0) { \ - if ((resultHandling) > 0) { \ - Tcl_IncrRefCount(objResultPtr); \ - } \ - pc += (pcAdjustment); \ - switch (nCleanup) { \ - case 1: goto cleanup1_pushObjResultPtr; \ - case 2: goto cleanup2_pushObjResultPtr; \ - case 0: break; \ - } \ - } else { \ - pc += (pcAdjustment); \ - switch (nCleanup) { \ - case 1: goto cleanup1; \ - case 2: goto cleanup2; \ - case 0: break; \ - } \ - } \ +#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ + do { \ + TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \ + CHECK_STACK(); \ + if (nCleanup == 0) { \ + if (resultHandling != 0) { \ + if ((resultHandling) > 0) { \ + PUSH_OBJECT(objResultPtr); \ + } else { \ + *(++tosPtr) = objResultPtr; \ + } \ + } \ + pc += (pcAdjustment); \ + goto cleanup0; \ + } else if (resultHandling != 0) { \ + if ((resultHandling) > 0) { \ + Tcl_IncrRefCount(objResultPtr); \ + } \ + pc += (pcAdjustment); \ + switch (nCleanup) { \ + case 1: goto cleanup1_pushObjResultPtr; \ + case 2: goto cleanup2_pushObjResultPtr; \ + case 0: break; \ + } \ + } else { \ + pc += (pcAdjustment); \ + switch (nCleanup) { \ + case 1: goto cleanup1; \ + case 2: goto cleanup2; \ + case 0: break; \ + } \ + } \ } while (0) -#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ - CHECK_STACK(); \ - do { \ - pc += (pcAdjustment); \ - cleanup = (nCleanup); \ - if (resultHandling) { \ - if ((resultHandling) > 0) { \ - Tcl_IncrRefCount(objResultPtr); \ - } \ - goto cleanupV_pushObjResultPtr; \ - } else { \ - goto cleanupV; \ - } \ +#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ + CHECK_STACK(); \ + do { \ + pc += (pcAdjustment); \ + cleanup = (nCleanup); \ + if (resultHandling) { \ + if ((resultHandling) > 0) { \ + Tcl_IncrRefCount(objResultPtr); \ + } \ + goto cleanupV_pushObjResultPtr; \ + } else { \ + goto cleanupV; \ + } \ } while (0) #ifndef TCL_COMPILE_DEBUG @@ -258,16 +258,16 @@ VarHashCreateVar( switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ - break; \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ @@ -275,7 +275,7 @@ VarHashCreateVar( objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_F(0, (cleanup), 1); \ - break; \ + break; \ } \ } while (0) #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ @@ -284,16 +284,16 @@ VarHashCreateVar( switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ - break; \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ @@ -301,7 +301,7 @@ VarHashCreateVar( objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_V(0, (cleanup), 1); \ - break; \ + break; \ } \ } while (0) #else /* TCL_COMPILE_DEBUG */ @@ -377,13 +377,14 @@ VarHashCreateVar( #ifdef TCL_COMPILE_DEBUG # define TRACE(a) \ - while (traceInstructions) { \ - fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ - GetOpcodeName(pc)); \ - printf a; \ - break; \ + while (traceInstructions) { \ + fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER \ + "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ + CURR_DEPTH, \ + (pc - codePtr->codeStart), \ + GetOpcodeName(pc)); \ + printf a; \ + break; \ } # define TRACE_APPEND(a) \ while (traceInstructions) { \ @@ -393,15 +394,16 @@ VarHashCreateVar( # define TRACE_ERROR(interp) \ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); # define TRACE_WITH_OBJ(a, objPtr) \ - while (traceInstructions) { \ - fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ - GetOpcodeName(pc)); \ - printf a; \ - TclPrintObject(stdout, objPtr, 30); \ - fprintf(stdout, "\n"); \ - break; \ + while (traceInstructions) { \ + fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER \ + "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ + CURR_DEPTH, \ + (pc - codePtr->codeStart), \ + GetOpcodeName(pc)); \ + printf a; \ + TclPrintObject(stdout, objPtr, 30); \ + fprintf(stdout, "\n"); \ + break; \ } # define O2S(objPtr) \ (objPtr ? TclGetString(objPtr) : "") @@ -475,7 +477,8 @@ VarHashCreateVar( * usage in [incr]: do the first summand and the sum have != signs? */ -#define Overflowing(a,b,sum) ((((a)^(sum)) < 0) && (((a)^(b)) >= 0)) +#define Overflowing(a,b,sum) \ + ((((a)^(sum)) < 0) && (((a)^(b)) >= 0)) /* * Macro for checking whether the type is NaN, used when we're thinking about @@ -1406,8 +1409,7 @@ CompileExprObj( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - ByteCode *codePtr = NULL; - /* Tcl Internal type of bytecode. Initialized + ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ /* @@ -1562,7 +1564,7 @@ TclCompileObj( int word) { Interp *iPtr = (Interp *) interp; - ByteCode *codePtr; /* Tcl Internal type of bytecode. */ + ByteCode *codePtr; /* Tcl Internal type of bytecode. */ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; /* @@ -2026,8 +2028,8 @@ TEBCresume( Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ const unsigned char *pc = (const unsigned char *)data[1]; - /* The current program counter. */ - unsigned char inst; /* The currently running instruction */ + /* The current program counter. */ + unsigned char inst; /* The currently running instruction */ /* * Transfer variables - needed only between opcodes, but not while @@ -2036,7 +2038,7 @@ TEBCresume( int cleanup = PTR2INT(data[2]); Tcl_Obj *objResultPtr; - int checkInterp = 0; /* Indicates when a check of interp readyness + int checkInterp = 0; /* Indicates when a check of interp readyness * is necessary. Set by CACHE_STACK_INFO() */ /* @@ -2090,7 +2092,7 @@ TEBCresume( goto cleanup0; } else { - /* resume from invocation */ + /* resume from invocation */ CACHE_STACK_INFO(); NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); @@ -2580,14 +2582,15 @@ TEBCresume( case INST_REVERSE: { Tcl_Obj **a, **b; - opnd = TclGetUInt4AtPtr(pc+1); - a = tosPtr-(opnd-1); + opnd = TclGetUInt4AtPtr(pc + 1); + a = tosPtr - (opnd - 1); b = tosPtr; - while (a OK\n", opnd)); NEXT_INST_F(5, 0, 0); @@ -2618,7 +2621,7 @@ TEBCresume( */ opnd = TclGetUInt4AtPtr(pc+1); - objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); + objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd - 1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); break; @@ -3181,7 +3184,7 @@ TEBCresume( O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr))); } #endif - varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG, + varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (!varPtr) { TRACE_ERROR(interp); @@ -3772,7 +3775,7 @@ TEBCresume( if (varPtr) { if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) { DECACHE_STACK_INFO(); - TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr, + TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, part2Ptr, TCL_TRACE_READS, 0, -1); CACHE_STACK_INFO(); } @@ -4696,7 +4699,7 @@ TEBCresume( } /* - * End of TclOO support instructions. + * End of TclOO support instructions. * ----------------------------------------------------------------- * Start of INST_LIST and related instructions. */ @@ -4733,7 +4736,7 @@ TEBCresume( TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); /* special case for AbstractList */ - if (TclObjTypeHasProc(valuePtr,indexProc)) { + if (TclObjTypeHasProc(valuePtr, indexProc)) { DECACHE_STACK_INFO(); length = TclObjTypeLength(valuePtr); if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) { @@ -4824,7 +4827,7 @@ TEBCresume( */ /* special case for AbstractList */ - if (TclObjTypeHasProc(valuePtr,indexProc)) { + if (TclObjTypeHasProc(valuePtr, indexProc)) { length = TclObjTypeLength(valuePtr); /* Decode end-offset index values. */ @@ -4923,11 +4926,11 @@ TEBCresume( DECACHE_STACK_INFO(); if (TclObjTypeHasProc(valuePtr, setElementProc)) { objResultPtr = TclObjTypeSetElement(interp, - valuePtr, numIndices, - &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); + valuePtr, numIndices, + &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } else { objResultPtr = TclLsetFlat(interp, valuePtr, numIndices, - &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); + &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } if (!objResultPtr) { CACHE_STACK_INFO(); @@ -5073,60 +5076,60 @@ TEBCresume( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - s1 = TclGetStringFromObj(valuePtr, &s1len); - TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); - - if (TclObjTypeHasProc(value2Ptr,inOperProc) != NULL) { - int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match); - if (status != TCL_OK) { - TRACE_ERROR(interp); - goto gotError; - } - } else { - - if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { - TRACE_ERROR(interp); - goto gotError; - } - match = 0; - if (length > 0) { - Tcl_Size i = 0; - Tcl_Obj *o; - int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL; - - /* - * An empty list doesn't match anything. - */ - - do { - if (isAbstractList) { - DECACHE_STACK_INFO(); - if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) { - CACHE_STACK_INFO(); - TRACE_ERROR(interp); - goto gotError; - } - CACHE_STACK_INFO(); - } else { - Tcl_ListObjIndex(NULL, value2Ptr, i, &o); - } - if (o != NULL) { - s2 = TclGetStringFromObj(o, &s2len); - } else { - s2 = ""; - s2len = 0; - } - if (s1len == s2len) { - match = (memcmp(s1, s2, s1len) == 0); - } - - /* Could be an ephemeral abstract obj */ - Tcl_BounceRefCount(o); - - i++; - } while (i < length && match == 0); - } - } + s1 = TclGetStringFromObj(valuePtr, &s1len); + TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); + + if (TclObjTypeHasProc(value2Ptr, inOperProc) != NULL) { + int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match); + if (status != TCL_OK) { + TRACE_ERROR(interp); + goto gotError; + } + } else { + + if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { + TRACE_ERROR(interp); + goto gotError; + } + match = 0; + if (length > 0) { + Tcl_Size i = 0; + Tcl_Obj *o; + int isAbstractList = TclObjTypeHasProc(value2Ptr, indexProc) != NULL; + + /* + * An empty list doesn't match anything. + */ + + do { + if (isAbstractList) { + DECACHE_STACK_INFO(); + if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) { + CACHE_STACK_INFO(); + TRACE_ERROR(interp); + goto gotError; + } + CACHE_STACK_INFO(); + } else { + Tcl_ListObjIndex(NULL, value2Ptr, i, &o); + } + if (o != NULL) { + s2 = TclGetStringFromObj(o, &s2len); + } else { + s2 = ""; + s2len = 0; + } + if (s1len == s2len) { + match = (memcmp(s1, s2, s1len) == 0); + } + + /* Could be an ephemeral abstract obj */ + Tcl_BounceRefCount(o); + + i++; + } while (i < length && match == 0); + } + } if (*pc == INST_LIST_NOT_IN) { match = !match; @@ -5165,8 +5168,7 @@ TEBCresume( NEXT_INST_F(1, 1, 0); } - case INST_LREPLACE4: - { + case INST_LREPLACE4: { size_t numToDelete, numNewElems; int end_indicator; int haveSecondIndex, flags; @@ -5562,7 +5564,7 @@ TEBCresume( if ((*ustring1 == *ustring2) && /* Fix bug [69218ab7b]: restrict max compare length. */ ((end - ustring1) >= length2) && (length2 == 1 || - memcmp(ustring1, ustring2, + memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); @@ -7381,7 +7383,7 @@ TEBCresume( goto gotError; } DECACHE_STACK_INFO(); - result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1, + result = TclDictWithFinish(interp, varPtr, arrayPtr, varNamePtr, NULL, -1, objc, objv, keysPtr); CACHE_STACK_INFO(); TclDecrRefCount(keysPtr); @@ -7424,38 +7426,36 @@ TEBCresume( * ----------------------------------------------------------------- */ - case INST_CLOCK_READ: - { /* Read the wall clock */ - Tcl_WideInt wval; - Tcl_Time now; - switch (TclGetUInt1AtPtr(pc+1)) { - case 0: /* clicks */ + case INST_CLOCK_READ: { /* Read the wall clock */ + Tcl_WideInt wval; + Tcl_Time now; + switch (TclGetUInt1AtPtr(pc+1)) { + case 0: /* clicks */ #ifdef TCL_WIDE_CLICKS - wval = TclpGetWideClicks(); + wval = TclpGetWideClicks(); #else - wval = (Tcl_WideInt)TclpGetClicks(); + wval = (Tcl_WideInt)TclpGetClicks(); #endif - break; - case 1: /* microseconds */ - Tcl_GetTime(&now); - wval = (Tcl_WideInt)now.sec * 1000000 + now.usec; - break; - case 2: /* milliseconds */ - Tcl_GetTime(&now); - wval = (Tcl_WideInt)now.sec * 1000 + now.usec / 1000; - break; - case 3: /* seconds */ - Tcl_GetTime(&now); - wval = (Tcl_WideInt)now.sec; - break; - default: - Tcl_Panic("clockRead instruction with unknown clock#"); - } - TclNewIntObj(objResultPtr, wval); - TRACE_WITH_OBJ(("=> "), objResultPtr); - NEXT_INST_F(2, 0, 1); + break; + case 1: /* microseconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt)now.sec * 1000000 + now.usec; + break; + case 2: /* milliseconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt)now.sec * 1000 + now.usec / 1000; + break; + case 3: /* seconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt)now.sec; + break; + default: + Tcl_Panic("clockRead instruction with unknown clock#"); } - break; + TclNewIntObj(objResultPtr, wval); + TRACE_WITH_OBJ(("=> "), objResultPtr); + NEXT_INST_F(2, 0, 1); + } default: Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc); @@ -8654,17 +8654,17 @@ ExecuteExtendedBinaryMathOp( Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); err = mp_init(&bigResult); if (err == MP_OKAY) { - switch (opcode) { - case INST_ADD: + switch (opcode) { + case INST_ADD: err = mp_add(&big1, &big2, &bigResult); break; - case INST_SUB: + case INST_SUB: err = mp_sub(&big1, &big2, &bigResult); break; - case INST_MULT: + case INST_MULT: err = mp_mul(&big1, &big2, &bigResult); break; - case INST_DIV: + case INST_DIV: if (mp_iszero(&big2)) { mp_clear(&big1); mp_clear(&big2); @@ -8958,19 +8958,26 @@ TclCompareTwoNumbers( static void PrintByteCodeInfo( - ByteCode *codePtr) /* The bytecode whose summary is printed to + 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 %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n", + fprintf(stdout, + "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER + "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" + TCL_Z_MODIFIER "u)\n", codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); fprintf(stdout, " Source: "); TclPrintSource(stdout, codePtr->source, 60); - fprintf(stdout, "\n Cmds %" TCL_Z_MODIFIER "u, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n", + fprintf(stdout, + "\n Cmds %" TCL_Z_MODIFIER "u, src %" TCL_Z_MODIFIER + "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER + "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER + "u, code/src %.2f\n", codePtr->numCommands, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, codePtr->maxStackDepth, @@ -8981,8 +8988,11 @@ PrintByteCodeInfo( 0.0); #ifdef TCL_COMPILE_STATS - fprintf(stdout, " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER - "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n", + fprintf(stdout, + " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER + "u+inst %" TCL_Z_MODIFIER "u+litObj %" TCL_Z_MODIFIER + "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER + "u+cmdMap %" TCL_Z_MODIFIER "u\n", codePtr->structureSize, offsetof(ByteCode, localCachePtr), codePtr->numCodeBytes, @@ -8993,7 +9003,8 @@ PrintByteCodeInfo( #endif /* TCL_COMPILE_STATS */ if (procPtr != NULL) { fprintf(stdout, - " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %" TCL_Z_MODIFIER "u\n", + " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %" + TCL_Z_MODIFIER "u, compiled locals %" TCL_Z_MODIFIER "u\n", procPtr, procPtr->refCount, procPtr->numArgs, procPtr->numCompiledLocals); } @@ -9022,7 +9033,7 @@ PrintByteCodeInfo( #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( - ByteCode *codePtr, /* The bytecode whose summary is printed to + 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. */ @@ -9062,7 +9073,7 @@ ValidatePcAndStackTop( TclNewLiteralStringObj(message, "\n executing "); Tcl_IncrRefCount(message); Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL); - fprintf(stderr,"%s\n", TclGetString(message)); + fprintf(stderr, "%s\n", TclGetString(message)); Tcl_DecrRefCount(message); } else { fprintf(stderr, "\n"); @@ -9094,7 +9105,7 @@ static void IllegalExprOperandType( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ - const unsigned char *pc, /* Points to the instruction being executed + const unsigned char *pc, /* Points to the instruction being executed * when the illegal type was found. */ Tcl_Obj *opndPtr) /* Points to the operand holding the value * with the illegal type. */ @@ -9158,21 +9169,21 @@ TclGetSourceFromFrame( Tcl_Obj *const objv[]) { if (cfPtr == NULL) { - return Tcl_NewListObj(objc, objv); + return Tcl_NewListObj(objc, objv); } if (cfPtr->cmdObj == NULL) { - if (cfPtr->cmd == NULL) { + if (cfPtr->cmd == NULL) { ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; - cfPtr->cmd = GetSrcInfoForPc((unsigned char *) + cfPtr->cmd = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); - } + } if (cfPtr->cmd) { cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len); } else { cfPtr->cmdObj = Tcl_NewListObj(objc, objv); } - Tcl_IncrRefCount(cfPtr->cmdObj); + Tcl_IncrRefCount(cfPtr->cmdObj); } return cfPtr->cmdObj; } @@ -9544,7 +9555,7 @@ TclExprFloatError( int TclLog2( - int value) /* The integer for which to compute the log + int value) /* The integer for which to compute the log * base 2. */ { int n = value; @@ -9813,23 +9824,23 @@ EvalStatsCmd( currentHeaderBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Instructions %12.6g %8.1f%% %8.1f\n", statsPtr->currentInstBytes, - Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentInstBytes, statsPtr->currentByteCodeBytes), statsPtr->currentInstBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Literal ptr array %12.6g %8.1f%% %8.1f\n", statsPtr->currentLitBytes, - Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentLitBytes, statsPtr->currentByteCodeBytes), statsPtr->currentLitBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Exception table %12.6g %8.1f%% %8.1f\n", statsPtr->currentExceptBytes, - Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentExceptBytes, statsPtr->currentByteCodeBytes), statsPtr->currentExceptBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Auxiliary data %12.6g %8.1f%% %8.1f\n", statsPtr->currentAuxBytes, - Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentAuxBytes, statsPtr->currentByteCodeBytes), statsPtr->currentAuxBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Command map %12.6g %8.1f%% %8.1f\n", statsPtr->currentCmdMapBytes, - Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentCmdMapBytes, statsPtr->currentByteCodeBytes), statsPtr->currentCmdMapBytes / numCurrentByteCodes); /* diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index b12162c..8ded940 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -918,8 +918,8 @@ FileBasename( Tcl_IncrRefCount(splitPtr); if (objc != 0) { - /* - * Return the last component, unless it is the only component, and it + /* + * Return the last component, unless it is the only component, and it * is the root of an absolute path. */ @@ -1115,7 +1115,7 @@ TclFileAttrsCmd( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\", there are no file attributes in this" " filesystem", TclGetString(objv[0]))); - Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR", "NONE", (void *)NULL); goto end; } @@ -1139,7 +1139,7 @@ TclFileAttrsCmd( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\", there are no file attributes in this" " filesystem", TclGetString(objv[0]))); - Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR", "NONE", (void *)NULL); goto end; } @@ -1519,7 +1519,7 @@ TclFileTemporaryCmd( */ makeTemporary: - chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj); + chan = TclpOpenTemporaryFile(tempDirObj, tempBaseObj, tempExtObj, nameObj); /* * If we created pieces of template, get rid of them now. diff --git a/generic/tclFileName.c b/generic/tclFileName.c index c99244c..9ef5b92 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -348,7 +348,7 @@ Tcl_GetPathType( const char *path) { Tcl_PathType type; - Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1); + Tcl_Obj *tempObj = Tcl_NewStringObj(path, -1); Tcl_IncrRefCount(tempObj); type = Tcl_FSGetPathType(tempObj); @@ -381,8 +381,9 @@ Tcl_GetPathType( Tcl_PathType TclpGetNativePathType( Tcl_Obj *pathPtr, /* Native path of interest */ - Tcl_Size *driveNameLengthPtr, /* Returns length of drive, if non-NULL and - * path was absolute */ + Tcl_Size *driveNameLengthPtr, + /* Returns length of drive, if non-NULL and + * path was absolute */ Tcl_Obj **driveNameRef) { Tcl_PathType type = TCL_PATH_ABSOLUTE; @@ -390,50 +391,50 @@ TclpGetNativePathType( switch (tclPlatform) { case TCL_PLATFORM_UNIX: { - const char *origPath = path; - - /* - * Paths that begin with / are absolute. - */ - - if (path[0] == '/') { - ++path; - /* - * Check for "//" network path prefix - */ - if ((*path == '/') && path[1] && (path[1] != '/')) { - path += 2; - while (*path && *path != '/') { - ++path; - } - } - if (driveNameLengthPtr != NULL) { - /* - * We need this addition in case the "//" code was used. - */ - - *driveNameLengthPtr = (path - origPath); - } - } else { - type = TCL_PATH_RELATIVE; - } - break; + const char *origPath = path; + + /* + * Paths that begin with / are absolute. + */ + + if (path[0] == '/') { + ++path; + /* + * Check for "//" network path prefix + */ + if ((*path == '/') && path[1] && (path[1] != '/')) { + path += 2; + while (*path && *path != '/') { + ++path; + } + } + if (driveNameLengthPtr != NULL) { + /* + * We need this addition in case the "//" code was used. + */ + + *driveNameLengthPtr = (path - origPath); + } + } else { + type = TCL_PATH_RELATIVE; + } + break; } case TCL_PLATFORM_WINDOWS: { - Tcl_DString ds; - const char *rootEnd; - - Tcl_DStringInit(&ds); - rootEnd = ExtractWinRoot(path, &ds, 0, &type); - if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { - *driveNameLengthPtr = rootEnd - path; - if (driveNameRef != NULL) { - *driveNameRef = Tcl_DStringToObj(&ds); - Tcl_IncrRefCount(*driveNameRef); - } - } - Tcl_DStringFree(&ds); - break; + Tcl_DString ds; + const char *rootEnd; + + Tcl_DStringInit(&ds); + rootEnd = ExtractWinRoot(path, &ds, 0, &type); + if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { + *driveNameLengthPtr = rootEnd - path; + if (driveNameRef != NULL) { + *driveNameRef = Tcl_DStringToObj(&ds); + Tcl_IncrRefCount(*driveNameRef); + } + } + Tcl_DStringFree(&ds); + break; } } return type; @@ -654,9 +655,8 @@ SplitUnixPath( } length = path - elementStart; if (length > 0) { - Tcl_Obj *nextElt; - nextElt = Tcl_NewStringObj(elementStart, length); - Tcl_ListObjAppendElement(NULL, result, nextElt); + Tcl_Obj *nextElt = Tcl_NewStringObj(elementStart, length); + Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*path++ == '\0') { break; @@ -980,8 +980,8 @@ Tcl_JoinPath( * * Results: * The return value is a pointer to a string containing the name. - * This may either be the name pointer passed in or space allocated in - * bufferPtr. In all cases, if the return value is not NULL, the caller + * This may either be the name pointer passed in or space allocated in + * bufferPtr. In all cases, if the return value is not NULL, the caller * must call Tcl_DStringFree() to free the space. If there was an * error in processing the name, then an error message is left in the * interp's result (if interp was not NULL) and the return value is NULL. @@ -1132,7 +1132,7 @@ Tcl_GlobObjCmd( GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS, GLOB_TYPE, GLOB_LAST } index; - enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1}; + enum pathDirOptions {PATH_NONE = -1, PATH_GENERAL = 0, PATH_DIR = 1}; Tcl_GlobTypeData *globTypes = NULL; globFlags = 0; @@ -1193,7 +1193,7 @@ Tcl_GlobObjCmd( case GLOB_JOIN: /* -join */ join = 1; break; - case GLOB_TAILS: /* -tails */ + case GLOB_TAILS: /* -tails */ globFlags |= TCL_GLOBMODE_TAILS; break; case GLOB_PATH: /* -path */ @@ -1259,7 +1259,7 @@ Tcl_GlobObjCmd( if (dir == PATH_GENERAL) { Tcl_Size pathlength; const char *last; - const char *first = TclGetStringFromObj(pathOrDir,&pathlength); + const char *first = TclGetStringFromObj(pathOrDir, &pathlength); /* * Find the last path separator in the path @@ -2255,7 +2255,7 @@ DoGlob( */ Tcl_Size len; - const char *joined = TclGetStringFromObj(joinedPtr,&len); + const char *joined = TclGetStringFromObj(joinedPtr, &len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { Tcl_AppendToObj(joinedPtr, "/", 1); @@ -2292,7 +2292,7 @@ DoGlob( */ Tcl_Size len; - const char *joined = TclGetStringFromObj(joinedPtr,&len); + const char *joined = TclGetStringFromObj(joinedPtr, &len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) { diff --git a/generic/tclHash.c b/generic/tclHash.c index 89807e2..630f8c9 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -60,30 +60,30 @@ static Tcl_HashEntry * FindHashEntry(Tcl_HashTable *tablePtr, const char *key); static void RebuildTable(Tcl_HashTable *tablePtr); const Tcl_HashKeyType tclArrayHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ - TCL_HASH_KEY_RANDOMIZE_HASH, /* flags */ - HashArrayKey, /* hashKeyProc */ - CompareArrayKeys, /* compareKeysProc */ - AllocArrayEntry, /* allocEntryProc */ - NULL /* freeEntryProc */ + TCL_HASH_KEY_TYPE_VERSION, /* version */ + TCL_HASH_KEY_RANDOMIZE_HASH,/* flags */ + HashArrayKey, /* hashKeyProc */ + CompareArrayKeys, /* compareKeysProc */ + AllocArrayEntry, /* allocEntryProc */ + NULL /* freeEntryProc */ }; const Tcl_HashKeyType tclOneWordHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ - 0, /* flags */ - NULL, /* HashOneWordKey, */ /* hashProc */ - NULL, /* CompareOneWordKey, */ /* compareProc */ - NULL, /* AllocOneWordKey, */ /* allocEntryProc */ - NULL /* FreeOneWordKey, */ /* freeEntryProc */ + TCL_HASH_KEY_TYPE_VERSION, /* version */ + 0, /* flags */ + NULL, /* HashOneWordKey, */ /* hashProc */ + NULL, /* CompareOneWordKey, * compareProc */ + NULL, /* AllocOneWordKey, *//* allocEntryProc */ + NULL /* FreeOneWordKey, */ /* freeEntryProc */ }; const Tcl_HashKeyType tclStringHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ - 0, /* flags */ - HashStringKey, /* hashKeyProc */ - CompareStringKeys, /* compareKeysProc */ - AllocStringEntry, /* allocEntryProc */ - NULL /* freeEntryProc */ + TCL_HASH_KEY_TYPE_VERSION, /* version */ + 0, /* flags */ + HashStringKey, /* hashKeyProc */ + CompareStringKeys, /* compareKeysProc */ + AllocStringEntry, /* allocEntryProc */ + NULL /* freeEntryProc */ }; /* @@ -106,8 +106,7 @@ const Tcl_HashKeyType tclStringHashKeyType = { void Tcl_InitHashTable( - Tcl_HashTable *tablePtr, - /* Pointer to table record, which is supplied + 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 @@ -144,14 +143,14 @@ Tcl_InitHashTable( void Tcl_InitCustomHashTable( - Tcl_HashTable *tablePtr, - /* Pointer to table record, which is supplied + 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 + const Tcl_HashKeyType *typePtr) + /* Pointer to structure which defines the * behaviour of this table. */ { #if (TCL_SMALL_HASH_TABLE != 4) @@ -285,7 +284,7 @@ CreateHashEntry( } /* if keys pointers or values are equal */ if ((key == hPtr->key.oneWordValue) - || compareKeysProc((void *) key, hPtr)) { + || compareKeysProc((void *) key, hPtr)) { if (newPtr) { *newPtr = 0; } @@ -556,8 +555,7 @@ Tcl_FirstHashEntry( Tcl_HashEntry * Tcl_NextHashEntry( - Tcl_HashSearch *searchPtr) - /* Place to store information about progress + Tcl_HashSearch *searchPtr) /* Place to store information about progress * through the table. Must have been * initialized by calling * Tcl_FirstHashEntry. */ @@ -671,7 +669,7 @@ Tcl_HashStats( static Tcl_HashEntry * AllocArrayEntry( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key to store in the hash table entry. */ + void *keyPtr) /* Key to store in the hash table entry. */ { Tcl_HashEntry *hPtr; size_t count = tablePtr->keyType * sizeof(int); @@ -707,7 +705,7 @@ AllocArrayEntry( static int CompareArrayKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { size_t count = hPtr->tablePtr->keyType * sizeof(int); @@ -736,7 +734,7 @@ CompareArrayKeys( static size_t HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key from which to compute hash value. */ + void *keyPtr) /* Key from which to compute hash value. */ { const int *array = (const int *) keyPtr; size_t result; @@ -768,7 +766,7 @@ HashArrayKey( static Tcl_HashEntry * AllocStringEntry( TCL_UNUSED(Tcl_HashTable *), - void *keyPtr) /* Key to store in the hash table entry. */ + void *keyPtr) /* Key to store in the hash table entry. */ { const char *string = (const char *) keyPtr; Tcl_HashEntry *hPtr; @@ -804,7 +802,7 @@ AllocStringEntry( static int CompareStringKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { return !strcmp((char *)keyPtr, hPtr->key.string); @@ -830,7 +828,7 @@ CompareStringKeys( static size_t HashStringKey( TCL_UNUSED(Tcl_HashTable *), - void *keyPtr) /* Key from which to compute hash value. */ + void *keyPtr) /* Key from which to compute hash value. */ { const char *string = (const char *)keyPtr; size_t result; diff --git a/generic/tclIO.c b/generic/tclIO.c index eec6062..59bf248 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -230,12 +230,12 @@ static Tcl_Size Write(Channel *chanPtr, const char *src, static Tcl_Obj * FixLevelCode(Tcl_Obj *msg); static void SpliceChannel(Tcl_Channel chan); static void CutChannel(Tcl_Channel chan); -static int WillRead(Channel *chanPtr); +static int WillRead(Channel *chanPtr); #define WriteChars(chanPtr, src, srcLen) \ - Write(chanPtr, src, srcLen, chanPtr->state->encoding) + Write(chanPtr, src, srcLen, chanPtr->state->encoding) #define WriteBytes(chanPtr, src, srcLen) \ - Write(chanPtr, src, srcLen, tclIdentityEncoding) + Write(chanPtr, src, srcLen, tclIdentityEncoding) /* * Simplifying helper macros. All may use their argument(s) multiple times. @@ -313,7 +313,7 @@ static int WillRead(Channel *chanPtr); */ #define HaveOpt(minLength, nameString) \ - ((len > (minLength)) && (optionName[1] == (nameString)[1]) \ + ((len > (minLength)) && (optionName[1] == (nameString)[1]) \ && (strncmp(optionName, (nameString), len) == 0)) /* @@ -335,35 +335,32 @@ static void FreeChannelInternalRep(Tcl_Obj *objPtr); static const Tcl_ObjType chanObjType = { "channel", /* name for this type */ - FreeChannelInternalRep, /* freeIntRepProc */ - DupChannelInternalRep, /* dupIntRepProc */ + FreeChannelInternalRep, /* freeIntRepProc */ + DupChannelInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; -#define GetIso88591() \ - (binaryEncoding ? Tcl_GetEncoding(NULL, "iso8859-1") : binaryEncoding) - -#define ChanSetInternalRep(objPtr, resPtr) \ +#define ChanSetInternalRep(objPtr, resPtr) \ do { \ Tcl_ObjInternalRep ir; \ (resPtr)->refCount++; \ ir.twoPtrValue.ptr1 = (resPtr); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &chanObjType, &ir); \ + Tcl_StoreInternalRep((objPtr), &chanObjType, &ir); \ } while (0) -#define ChanGetInternalRep(objPtr, resPtr) \ +#define ChanGetInternalRep(objPtr, resPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &chanObjType); \ - (resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL; \ + (resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) -#define BUSY_STATE(st, fl) \ - ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ - (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) +#define BUSY_STATE(statePtr, flags) \ + ((((statePtr)->csPtrR) && ((flags) & TCL_READABLE)) || \ + (((statePtr)->csPtrW) && ((flags) & TCL_WRITABLE))) #define MAX_CHANNEL_BUFFER_SIZE (1024*1024) @@ -849,7 +846,7 @@ Tcl_CreateCloseHandler( * callback. */ Tcl_CloseProc *proc, /* The callback routine to call when the * channel will be closed. */ - void *clientData) /* Arbitrary data to pass to the close + void *clientData) /* Arbitrary data to pass to the close * callback. */ { ChannelState *statePtr = ((Channel *) chan)->state; @@ -887,7 +884,7 @@ Tcl_DeleteCloseHandler( * callback. */ Tcl_CloseProc *proc, /* The procedure for the callback to * remove. */ - void *clientData) /* The callback data for the callback to + void *clientData) /* The callback data for the callback to * remove. */ { ChannelState *statePtr = ((Channel *) chan)->state; @@ -986,7 +983,7 @@ GetChannelTable( static void DeleteChannelTable( - void *clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { Tcl_HashTable *hTblPtr; /* The hash table. */ @@ -1596,9 +1593,10 @@ TclGetChannelFromObj( Tcl_Channel Tcl_CreateChannel( - const Tcl_ChannelType *typePtr, /* The channel type record. */ + const Tcl_ChannelType *typePtr, + /* The channel type record. */ const char *chanName, /* Name of channel to record. */ - void *instanceData, /* Instance specific data. */ + void *instanceData, /* Instance specific data. */ int mask) /* TCL_READABLE & TCL_WRITABLE to indicate if * the channel is readable, writable. */ { @@ -1808,7 +1806,7 @@ Tcl_StackChannel( const Tcl_ChannelType *typePtr, /* The channel type record for the new * channel. */ - void *instanceData, /* Instance specific data for the new + void *instanceData, /* Instance specific data for the new * channel. */ int mask, /* TCL_READABLE & TCL_WRITABLE to indicate if * the channel is readable, writable. */ @@ -2406,7 +2404,7 @@ int Tcl_GetChannelHandle( Tcl_Channel chan, /* The channel to get file from. */ int direction, /* TCL_WRITABLE or TCL_READABLE. */ - void **handlePtr) /* Where to store handle */ + void **handlePtr) /* Where to store handle */ { Channel *chanPtr; /* The actual channel. */ void *handle; @@ -2446,9 +2444,10 @@ Tcl_GetChannelHandle( int Tcl_RemoveChannelMode( - Tcl_Interp *interp, /* The interp for an error message. Allowed to be NULL. */ - Tcl_Channel chan, /* The channel which is modified. */ - int mode) /* The access mode to drop from the channel */ + Tcl_Interp *interp, /* The interp for an error message. Allowed to + * be NULL. */ + Tcl_Channel chan, /* The channel which is modified. */ + int mode) /* The access mode to drop from the channel */ { const char* emsg; ChannelState *statePtr = ((Channel *) chan)->state; @@ -2501,7 +2500,7 @@ Tcl_RemoveChannelMode( static ChannelBuffer * AllocChannelBuffer( - Tcl_Size length) /* Desired length of channel buffer. */ + Tcl_Size length) /* Desired length of channel buffer. */ { ChannelBuffer *bufPtr; Tcl_Size n; @@ -3424,7 +3423,7 @@ TclClose( * channel. */ Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of real IO channel. */ - int result = 0; /* Of calling FlushChannel. */ + int result = 0; /* Of calling FlushChannel. */ int flushcode; int stickyError; @@ -4041,8 +4040,8 @@ Tcl_Size Tcl_Write( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* Data to queue in output buffer. */ - Tcl_Size srcLen) /* Length of data in bytes, or TCL_INDEX_NONE for - * strlen(). */ + Tcl_Size srcLen) /* Length of data in bytes, or TCL_INDEX_NONE + * for strlen(). */ { /* * Always use the topmost channel of the stack @@ -4153,8 +4152,8 @@ Tcl_WriteChars( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* UTF-8 characters to queue in output * buffer. */ - Tcl_Size len) /* Length of string in bytes, or TCL_INDEX_NONE for - * strlen(). */ + Tcl_Size len) /* Length of string in bytes, or TCL_INDEX_NONE + * for strlen(). */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ @@ -5214,10 +5213,10 @@ TclGetsObjBinary( /* * Convert the buffer if there was an encoding. - * XXX - unimplemented. */ if (statePtr->encoding != GetBinaryEncoding()) { + // XXX - unimplemented! } /* @@ -5694,7 +5693,7 @@ Tcl_Size Tcl_Read( Tcl_Channel chan, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ + Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; @@ -5739,7 +5738,7 @@ Tcl_Size Tcl_ReadRaw( Tcl_Channel chan, /* The channel from which to read. */ char *readBuf, /* Where to store input read. */ - Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ + Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; @@ -6790,7 +6789,7 @@ Tcl_Size Tcl_Ungets( Tcl_Channel chan, /* The channel for which to add the input. */ const char *str, /* The input itself. */ - Tcl_Size len, /* The length of the input. */ + Tcl_Size len, /* The length of the input. */ int atEnd) /* If non-zero, add at end of queue; otherwise * add at head of queue. */ { @@ -7735,7 +7734,7 @@ Tcl_ChannelBuffered( void Tcl_SetChannelBufferSize( Tcl_Channel chan, /* The channel whose buffer size to set. */ - Tcl_Size sz) /* The size to set. */ + Tcl_Size sz) /* The size to set. */ { ChannelState *statePtr; /* State of real channel structure. */ @@ -8716,7 +8715,7 @@ UpdateInterest( TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc,chanPtr); + ChannelTimerProc, chanPtr); } ChanWatch(chanPtr, mask); @@ -8766,7 +8765,7 @@ ChannelTimerProc( * before UpdateInterest gets called by Tcl_NotifyChannel. */ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc,chanPtr); + ChannelTimerProc, chanPtr); Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE); } else { /* The channel may have just been closed from within Tcl_NotifyChannel */ @@ -8781,7 +8780,7 @@ ChannelTimerProc( */ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc,chanPtr); + ChannelTimerProc, chanPtr); Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); } else { CleanupTimerHandler(statePtr); @@ -8844,7 +8843,7 @@ Tcl_CreateChannelHandler( * handler. */ Tcl_ChannelProc *proc, /* Procedure to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ChannelHandler *chPtr; Channel *chanPtr = (Channel *) chan; @@ -8916,7 +8915,7 @@ Tcl_DeleteChannelHandler( Tcl_Channel chan, /* The channel for which to remove the * callback. */ Tcl_ChannelProc *proc, /* The procedure in the callback to delete. */ - void *clientData) /* The client data in the callback to + void *clientData) /* The client data in the callback to * delete. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -9122,7 +9121,7 @@ CreateScriptRecord( void TclChannelEventScriptInvoker( - void *clientData, /* The script+interp record. */ + void *clientData, /* The script+interp record. */ TCL_UNUSED(int) /*mask*/) { EventScriptRecord *esPtr = (EventScriptRecord *)clientData; @@ -9759,11 +9758,11 @@ CopyData( if (moveBytes) { size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb, - !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); + !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); } else { size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, - !GotFlag(inStatePtr, CHANNEL_NONBLOCKING) - ,0 /* No append */); + !GotFlag(inStatePtr, CHANNEL_NONBLOCKING), + 0 /* No append */); /* * In case of a recoverable encoding error, any data before * the error should be written. This data is in the bufObj. @@ -10029,7 +10028,7 @@ static Tcl_Size DoRead( Channel *chanPtr, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - Tcl_Size bytesToRead, /* Maximum number of bytes to read. */ + Tcl_Size bytesToRead, /* Maximum number of bytes to read. */ int allowShortReads) /* Allow half-blocking (pipes,sockets) */ { ChannelState *statePtr = chanPtr->state; @@ -11396,9 +11395,9 @@ Tcl_ChannelTruncateProc( static void DupChannelInternalRep( - Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have + 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 + Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { ResolvedChanName *resPtr; @@ -11453,7 +11452,7 @@ DumpFlags( int i = 0; char buf[24]; -#define ChanFlag(chr, bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_')) +#define ChanFlag(chr, bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_')) ChanFlag('r', TCL_READABLE); ChanFlag('w', TCL_WRITABLE); diff --git a/generic/tclIO.h b/generic/tclIO.h index 8823e06..00ca422 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -39,12 +39,12 @@ typedef struct ChannelBuffer { Tcl_Size refCount; /* Current uses count */ Tcl_Size nextAdded; /* The next position into which a character * will be put in the buffer. */ - Tcl_Size nextRemoved; /* Position of next byte to be removed from + Tcl_Size nextRemoved; /* Position of next byte to be removed from * the buffer. */ Tcl_Size bufLength; /* How big is the buffer? */ struct ChannelBuffer *nextPtr; /* Next buffer in chain. */ - char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real + char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real * buffer occupies this space + bufSize-1 * bytes. This must be the last field in the * structure. */ @@ -96,9 +96,10 @@ typedef struct EventScriptRecord { typedef struct Channel { struct ChannelState *state; /* Split out state information */ - void *instanceData; /* Instance-specific data provided by creator + void *instanceData; /* Instance-specific data provided by creator * of channel. */ - const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */ + const Tcl_ChannelType *typePtr; + /* Pointer to channel type structure. */ struct Channel *downChanPtr;/* Refers to channel this one was stacked * upon. This reference is NULL for normal * channels. See Tcl_StackChannel. */ @@ -215,7 +216,7 @@ typedef struct ChannelState { */ Tcl_Obj* chanMsg; - Tcl_Obj* unreportedMsg; /* Non-NULL if an error report was deferred + Tcl_Obj* unreportedMsg; /* Non-NULL if an error report was deferred * because it happened in the background. The * value is the chanMg, if any. #219's * companion to 'unreportedError'. */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index fc4ddb6..288a16b 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -369,8 +369,8 @@ Tcl_ReadObjCmd( { Tcl_Channel chan; /* The channel to read from. */ int newline, i; /* Discard newline at end? */ - Tcl_WideInt toRead; /* How many bytes to read? */ - Tcl_Size charactersRead; /* How many characters were read? */ + Tcl_WideInt toRead; /* How many bytes to read? */ + Tcl_Size charactersRead; /* How many characters were read? */ int mode; /* Mode in which channel is opened. */ Tcl_Obj *resultPtr, *chanObjPtr; @@ -1199,7 +1199,7 @@ Tcl_OpenObjCmd( static void TcpAcceptCallbacksDeleteProc( - void *clientData, /* Data which was passed when the assocdata + void *clientData, /* Data which was passed when the assocdata * was registered. */ TCL_UNUSED(Tcl_Interp *)) { @@ -1327,7 +1327,7 @@ UnregisterTcpServerInterpCleanupProc( static void AcceptCallbackProc( - void *callbackData, /* The data stored when the callback was + void *callbackData, /* The data stored when the callback was * created in the call to * Tcl_OpenTcpServer. */ Tcl_Channel chan, /* Channel for the newly accepted @@ -1418,7 +1418,7 @@ AcceptCallbackProc( static void TcpServerCloseProc( - void *callbackData) /* The data passed in the call to + void *callbackData) /* The data passed in the call to * Tcl_CreateCloseHandler. */ { AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData; diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index aa63cd0..5b521e4 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -515,7 +515,7 @@ ExecuteCallback( static int TransformBlockModeProc( - void *instanceData, /* State of transformation. */ + void *instanceData, /* State of transformation. */ int mode) /* New blocking mode. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; @@ -850,7 +850,7 @@ TransformOutputProc( static long long TransformWideSeekProc( - void *instanceData, /* The channel to manipulate. */ + void *instanceData, /* The channel to manipulate. */ long long offset, /* Size of movement. */ int mode, /* How to move. */ int *errorCodePtr) /* Location of error flag. */ @@ -1013,7 +1013,7 @@ TransformGetOptionProc( static void TransformWatchProc( - void *instanceData, /* Channel to watch. */ + void *instanceData, /* Channel to watch. */ int mask) /* Events of interest. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; @@ -1091,9 +1091,9 @@ TransformWatchProc( static int TransformGetFileHandleProc( - void *instanceData, /* Channel to query. */ + void *instanceData, /* Channel to query. */ int direction, /* Direction of interest. */ - void **handlePtr) /* Place to store the handle into. */ + void **handlePtr) /* Place to store the handle into. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; @@ -1125,7 +1125,7 @@ TransformGetFileHandleProc( static int TransformNotifyProc( - void *clientData, /* The state of the notified + void *clientData, /* The state of the notified * transformation. */ int mask) /* The mask of occurring events. */ { @@ -1170,7 +1170,7 @@ TransformNotifyProc( static void TransformChannelHandlerTimer( - void *clientData) /* Transformation to query. */ + void *clientData) /* Transformation to query. */ { TransformChannelData *dataPtr = (TransformChannelData *)clientData; diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 0118ce0..4379263 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -62,27 +62,27 @@ static void TimerRunWrite(void *clientData); */ static const Tcl_ChannelType tclRChannelType = { - "tclrchannel", /* Type name. */ - TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Old close API */ - ReflectInput, /* Handle read request */ - ReflectOutput, /* Handle write request */ + "tclrchannel", /* Type name. */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ + NULL, /* Old close API. Deprecated. */ + ReflectInput, /* Handle read request */ + ReflectOutput, /* Handle write request */ NULL, - ReflectSetOption, /* Set options. */ - ReflectGetOption, /* Get options. */ - ReflectWatch, /* Initialize notifier */ - NULL, /* Get OS handle from the channel. */ - ReflectClose, /* Close channel. Clean instance data */ - ReflectBlock, /* Set blocking/nonblocking. */ - NULL, /* Flush channel. */ - NULL, /* Handle events. */ - ReflectSeekWide, /* Move access point (64 bit). */ + ReflectSetOption, /* Set options. */ + ReflectGetOption, /* Get options. */ + ReflectWatch, /* Initialize notifier */ + NULL, /* Get OS handle from the channel. */ + ReflectClose, /* Close channel. Clean instance data */ + ReflectBlock, /* Set blocking/nonblocking. */ + NULL, /* Flush channel. */ + NULL, /* Handle events. */ + ReflectSeekWide, /* Move access point (64 bit). */ #if TCL_THREADS - ReflectThread, /* thread action, tracking owner */ + ReflectThread, /* thread action, tracking owner */ #else - NULL, /* thread action */ + NULL, /* thread action */ #endif - ReflectTruncate /* Truncate. */ + ReflectTruncate /* Truncate. */ }; /* @@ -205,9 +205,8 @@ typedef enum { #define RANDW \ (TCL_READABLE | TCL_WRITABLE) -#define IMPLIES(a,b) ((!(a)) || (b)) -#define NEGIMPL(a,b) -#define HAS(x,f) ((x) & FLAG(f)) +#define IMPLIES(a, b) ((!(a)) || (b)) +#define HAS(x, f) ((x) & FLAG(f)) #if TCL_THREADS /* @@ -397,27 +396,28 @@ static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr, static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(void *clientData); -#define FreeReceivedError(p) \ - if ((p)->base.mustFree) { \ - Tcl_Free((p)->base.msgStr); \ +#define FreeReceivedError(fwdParam) \ + if ((fwdParam)->base.mustFree) { \ + Tcl_Free((fwdParam)->base.msgStr); \ } -#define PassReceivedErrorInterp(i,p) \ - if ((i) != NULL) { \ - Tcl_SetChannelErrorInterp((i), \ - Tcl_NewStringObj((p)->base.msgStr, -1)); \ - } \ - FreeReceivedError(p) -#define PassReceivedError(c,p) \ - Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \ - FreeReceivedError(p) -#define ForwardSetStaticError(p,emsg) \ - (p)->base.code = TCL_ERROR; \ - (p)->base.mustFree = 0; \ - (p)->base.msgStr = (char *) (emsg) -#define ForwardSetDynamicError(p,emsg) \ - (p)->base.code = TCL_ERROR; \ - (p)->base.mustFree = 1; \ - (p)->base.msgStr = (char *) (emsg) +#define PassReceivedErrorInterp(interp, fwdParam) \ + if ((interp) != NULL) { \ + Tcl_SetChannelErrorInterp((interp), \ + Tcl_NewStringObj((fwdParam)->base.msgStr, -1)); \ + } \ + FreeReceivedError(fwdParam) +#define PassReceivedError(chan, fwdParam) \ + Tcl_SetChannelError((chan), \ + Tcl_NewStringObj((fwdParam)->base.msgStr, -1)); \ + FreeReceivedError(fwdParam) +#define ForwardSetStaticError(fwdParam, emsg) \ + (fwdParam)->base.code = TCL_ERROR; \ + (fwdParam)->base.mustFree = 0; \ + (fwdParam)->base.msgStr = (char *) (emsg) +#define ForwardSetDynamicError(fwdParam, emsg) \ + (fwdParam)->base.code = TCL_ERROR; \ + (fwdParam)->base.mustFree = 1; \ + (fwdParam)->base.msgStr = (char *) (emsg) static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); @@ -426,8 +426,8 @@ static Tcl_ExitProc DeleteThreadReflectedChannelMap; #endif /* TCL_THREADS */ -#define SetChannelErrorStr(c,msgStr) \ - Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1)) +#define SetChannelErrorStr(chan, msgStr) \ + Tcl_SetChannelError((chan), Tcl_NewStringObj((msgStr), -1)) static Tcl_Obj * MarshallError(Tcl_Interp *interp); static void UnmarshallErrorResult(Tcl_Interp *interp, @@ -1760,7 +1760,7 @@ ReflectBlock( Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); errorNum = EINVAL; } else { @@ -1830,7 +1830,7 @@ ReflectThread( static int ReflectSetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ const char *newValue) /* The new value */ @@ -1872,7 +1872,7 @@ ReflectSetOption( Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); - result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj); + result = InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, &resObj); if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); } @@ -1902,7 +1902,7 @@ ReflectSetOption( static int ReflectGetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of reuqested option */ Tcl_DString *dsPtr) /* String to place the result into */ @@ -2055,7 +2055,7 @@ ReflectGetOption( static int ReflectTruncate( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ long long length) /* Length to truncate to. */ { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; @@ -2091,7 +2091,7 @@ ReflectTruncate( lenObj = Tcl_NewWideIntObj(length); Tcl_IncrRefCount(lenObj); - if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_TRUNCATE, lenObj, NULL, &resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); errorNum = EINVAL; } else { @@ -2138,7 +2138,7 @@ EncodeEventMask( int *mask) { int events; /* Mask of events to post */ - Tcl_Size listc; /* #elements in eventspec list */ + Tcl_Size listc; /* #elements in eventspec list */ Tcl_Obj **listv; /* Elements of eventspec list */ int evIndex; /* Id of event for an element of the eventspec * list. */ @@ -2376,7 +2376,7 @@ InvokeTclMethod( */ if (resultObjPtr != NULL) { - resObj = Tcl_NewStringObj(msg_dstlost,-1); + resObj = Tcl_NewStringObj(msg_dstlost, -1); *resultObjPtr = resObj; Tcl_IncrRefCount(resObj); } @@ -2614,13 +2614,13 @@ MarkDead( static void DeleteReflectedChannelMap( - void *clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData; /* The map */ - Tcl_HashSearch hSearch; /* Search variable. */ - Tcl_HashEntry *hPtr; /* Search variable. */ + Tcl_HashSearch hSearch; /* Search variable. */ + Tcl_HashEntry *hPtr; /* Search variable. */ ReflectedChannel *rcPtr; Tcl_Channel chan; #if TCL_THREADS @@ -3340,7 +3340,7 @@ ForwardProc( Tcl_IncrRefCount(lenObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_TRUNCATE, lenObj, NULL, &resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 2ad6ecf0..869c19d 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -209,9 +209,9 @@ typedef enum { #define RANDW \ (TCL_READABLE | TCL_WRITABLE) -#define IMPLIES(a,b) ((!(a)) || (b)) -#define NEGIMPL(a,b) -#define HAS(x,f) ((x) & FLAG(f)) +#define IMPLIES(a, b) ((!(a)) || (b)) +#define NEGIMPL(a, b) +#define HAS(x, f) ((x) & FLAG(f)) #if TCL_THREADS /* @@ -356,37 +356,37 @@ static void ForwardOpToOwnerThread(ReflectedTransform *rtPtr, static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(void *clientData); -#define FreeReceivedError(p) \ +#define FreeReceivedError(fwdParam) \ do { \ - if ((p)->base.mustFree) { \ - Tcl_Free((p)->base.msgStr); \ + if ((fwdParam)->base.mustFree) { \ + Tcl_Free((fwdParam)->base.msgStr); \ } \ } while (0) -#define PassReceivedErrorInterp(i,p) \ +#define PassReceivedErrorInterp(interp, fwdParam) \ do { \ - if ((i) != NULL) { \ - Tcl_SetChannelErrorInterp((i), \ - Tcl_NewStringObj((p)->base.msgStr, -1)); \ + if ((interp) != NULL) { \ + Tcl_SetChannelErrorInterp((interp), \ + Tcl_NewStringObj((fwdParam)->base.msgStr, -1)); \ } \ - FreeReceivedError(p); \ + FreeReceivedError(fwdParam); \ } while (0) -#define PassReceivedError(c,p) \ +#define PassReceivedError(chan, fwdParam) \ do { \ - Tcl_SetChannelError((c), \ - Tcl_NewStringObj((p)->base.msgStr, -1)); \ - FreeReceivedError(p); \ + Tcl_SetChannelError((chan), \ + Tcl_NewStringObj((fwdParam)->base.msgStr, -1)); \ + FreeReceivedError(fwdParam); \ } while (0) -#define ForwardSetStaticError(p,emsg) \ +#define ForwardSetStaticError(fwdParam, emsg) \ do { \ - (p)->base.code = TCL_ERROR; \ - (p)->base.mustFree = 0; \ - (p)->base.msgStr = (char *) (emsg); \ + (fwdParam)->base.code = TCL_ERROR; \ + (fwdParam)->base.mustFree = 0; \ + (fwdParam)->base.msgStr = (char *) (emsg); \ } while (0) -#define ForwardSetDynamicError(p,emsg) \ +#define ForwardSetDynamicError(fwdParam, emsg) \ do { \ - (p)->base.code = TCL_ERROR; \ - (p)->base.mustFree = 1; \ - (p)->base.msgStr = (char *) (emsg); \ + (fwdParam)->base.code = TCL_ERROR; \ + (fwdParam)->base.mustFree = 1; \ + (fwdParam)->base.msgStr = (char *) (emsg); \ } while (0) static void ForwardSetObjError(ForwardParam *p, @@ -396,8 +396,8 @@ static void DeleteThreadReflectedTransformMap( void *clientData); #endif /* TCL_THREADS */ -#define SetChannelErrorStr(c,msgStr) \ - Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1)) +#define SetChannelErrorStr(chan, msgStr) \ + Tcl_SetChannelError((chan), Tcl_NewStringObj((msgStr), -1)) static Tcl_Obj * MarshallError(Tcl_Interp *interp); static void UnmarshallErrorResult(Tcl_Interp *interp, @@ -599,9 +599,9 @@ TclChanPushObjCmd( */ if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s initialize\" returned non-list: %s", - TclGetString(cmdObj), TclGetString(resObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s initialize\" returned non-list: %s", + TclGetString(cmdObj), TclGetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } @@ -624,9 +624,9 @@ TclChanPushObjCmd( Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" does not support all required methods", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" does not support all required methods", + TclGetString(cmdObj))); goto error; } @@ -646,9 +646,9 @@ TclChanPushObjCmd( } if (!mode) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" makes the channel inaccessible", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" makes the channel inaccessible", + TclGetString(cmdObj))); goto error; } @@ -657,16 +657,16 @@ TclChanPushObjCmd( */ if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"drain\" but not \"read\"", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"drain\" but not \"read\"", + TclGetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"flush\" but not \"write\"", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"flush\" but not \"write\"", + TclGetString(cmdObj))); goto error; } @@ -1926,7 +1926,7 @@ InvokeTclMethod( */ if (resultObjPtr != NULL) { - resObj = Tcl_NewStringObj(msg_dstlost,-1); + resObj = Tcl_NewStringObj(msg_dstlost, -1); *resultObjPtr = resObj; Tcl_IncrRefCount(resObj); } diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 81526fa..2ace4ce 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -191,7 +191,7 @@ TclCreateSocketAddress( if (host != NULL) { if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, NULL) != TCL_OK) { - Tcl_DStringFree(&ds); + Tcl_DStringFree(&ds); return 0; } native = Tcl_DStringValue(&ds); @@ -263,7 +263,7 @@ TclCreateSocketAddress( (result == EAI_SYSTEM) ? Tcl_PosixError(interp) : #endif /* EAI_SYSTEM */ gai_strerror(result); - return 0; + return 0; } /* diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index c3131cd..284b9d4 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -245,7 +245,7 @@ Tcl_Stat( { int ret; Tcl_StatBuf buf; - Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); + Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSStat(pathPtr, &buf); @@ -332,10 +332,10 @@ Tcl_Access( int mode) /* Permission setting. */ { int ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); + Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); Tcl_IncrRefCount(pathPtr); - ret = Tcl_FSAccess(pathPtr,mode); + ret = Tcl_FSAccess(pathPtr, mode); Tcl_DecrRefCount(pathPtr); return ret; @@ -352,7 +352,7 @@ Tcl_OpenFileChannel( int permissions) /* The modes to use if creating a new file. */ { Tcl_Channel ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); + Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions); @@ -367,7 +367,7 @@ Tcl_Chdir( const char *dirName) { int ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1); + Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName, -1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSChdir(pathPtr); Tcl_DecrRefCount(pathPtr); @@ -399,7 +399,7 @@ Tcl_EvalFile( * pathaname. */ { int ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1); + Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName, -1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSEvalFile(interp, pathPtr); @@ -1568,8 +1568,8 @@ TclGetOpenMode( if (mode & O_APPEND) { accessFlagRepeated: if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "access mode \"%s\" repeated", flag)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "access mode \"%s\" repeated", flag)); } goto invAccessMode; } @@ -1577,7 +1577,7 @@ TclGetOpenMode( *modeFlagsPtr |= 1; } else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) { if (mode & O_CREAT) { - goto accessFlagRepeated; + goto accessFlagRepeated; } mode |= O_CREAT; } else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) { @@ -1735,7 +1735,7 @@ Tcl_FSEvalFileEx( } if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { - Tcl_CloseEx(interp,chan,0); + Tcl_CloseEx(interp, chan, 0); return result; } @@ -2006,7 +2006,7 @@ Tcl_GetErrno(void) * Tcl_SetErrno -- * * Sets the Tcl error code to the given value. On some saner platforms - * this is implemented in the C library as a thread-local value , but this + * this is implemented in the C library as a thread-local value, but this * is *really* unsafe to assume! * * Results: @@ -2358,7 +2358,7 @@ NativeFileAttrsGet( Tcl_Obj *pathPtr, /* Pathname of the file */ Tcl_Obj **objPtrRef) /* Where to store the a pointer to the result. */ { - return tclpFileAttrProcs[index].getProc(interp, index, pathPtr,objPtrRef); + return tclpFileAttrProcs[index].getProc(interp, index, pathPtr, objPtrRef); } /* @@ -2653,7 +2653,7 @@ Tcl_FSGetCwd( retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd); Tcl_IncrRefCount(retVal); - norm = TclFSNormalizeAbsolutePath(interp,retVal); + norm = TclFSNormalizeAbsolutePath(interp, retVal); if (norm != NULL) { /* * Assign to global storage the pathname of the current @@ -2785,7 +2785,7 @@ Tcl_FSGetCwd( norm = TclFSNormalizeAbsolutePath(interp, retVal); if (norm == NULL) { - /* + /* * 'norm' shouldn't ever be NULL, but we are careful. */ @@ -2796,7 +2796,7 @@ Tcl_FSGetCwd( } else if (norm == tsdPtr->cwdPathPtr) { goto cdEqual; } else { - /* + /* * Determine whether the filesystem's answer is the same as the * cached local value. Since both 'norm' and 'tsdPtr->cwdPathPtr' * are normalized pathnames, do something more efficient than @@ -4014,7 +4014,7 @@ TclFSNonnativePathType( numVolumes--; Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol); - strVol = TclGetStringFromObj(vol,&len); + strVol = TclGetStringFromObj(vol, &len); if (pathLen < len) { continue; } @@ -4636,7 +4636,7 @@ NativeFilesystemSeparator( separator = "\\"; break; } - return Tcl_NewStringObj(separator,1); + return Tcl_NewStringObj(separator, 1); } /* diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 3e92b5a..5f6827d 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -55,7 +55,7 @@ const Tcl_ObjType tclIndexType = { typedef struct { void *tablePtr; /* Pointer to the table of strings */ - Tcl_Size offset; /* Offset between table entries */ + Tcl_Size offset; /* Offset between table entries */ Tcl_Size index; /* Selected index into table. */ } IndexRep; @@ -282,20 +282,21 @@ Tcl_GetIndexFromObjStruct( * operation. */ - if (objPtr && (index != TCL_INDEX_NONE) && !(flags & TCL_INDEX_TEMP_TABLE)) { - irPtr = TclFetchInternalRep(objPtr, &tclIndexType); - if (irPtr) { - indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; - } else { - Tcl_ObjInternalRep ir; + if (objPtr && (index != TCL_INDEX_NONE) + && !(flags & TCL_INDEX_TEMP_TABLE)) { + irPtr = TclFetchInternalRep(objPtr, &tclIndexType); + if (irPtr) { + indexRep = (IndexRep *) irPtr->twoPtrValue.ptr1; + } else { + Tcl_ObjInternalRep ir; - indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep)); - ir.twoPtrValue.ptr1 = indexRep; - Tcl_StoreInternalRep(objPtr, &tclIndexType, &ir); - } - indexRep->tablePtr = (void *) tablePtr; - indexRep->offset = offset; - indexRep->index = index; + indexRep = (IndexRep *) Tcl_Alloc(sizeof(IndexRep)); + ir.twoPtrValue.ptr1 = indexRep; + Tcl_StoreInternalRep(objPtr, &tclIndexType, &ir); + } + indexRep->tablePtr = (void *) tablePtr; + indexRep->offset = offset; + indexRep->index = index; } uncachedDone: @@ -806,7 +807,7 @@ PrefixLongestObjCmd( void Tcl_WrongNumArgs( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments to print from objv. */ + Tcl_Size objc, /* Number of arguments to print from objv. */ Tcl_Obj *const objv[], /* Initial argument objects, which should be * included in the error message. */ const char *message) /* Error message to print after the leading @@ -1002,20 +1003,19 @@ Tcl_ParseArgsObjv( * successful exit. Will include the name of * the command. */ Tcl_Size nrem; /* Size of leftovers.*/ - const Tcl_ArgvInfo *infoPtr; - /* Pointer to the current entry in the table + 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 + char c; /* Second character of current arg (used for * quick check for matching; use 2nd char. * because first char. will almost always be * '-'). */ - Tcl_Size srcIndex; /* Location from which to read next argument + Tcl_Size srcIndex; /* Location from which to read next argument * from objv. */ - Tcl_Size dstIndex; /* Used to keep track of current arguments + Tcl_Size dstIndex; /* Used to keep track of current arguments * being processed, primarily for error * reporting. */ Tcl_Size objc; /* # arguments in objv still to process. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 768143c..bb0178b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -790,7 +790,7 @@ typedef struct VarInHash { (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT #define TclSetVarUndefined(varPtr) \ - (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT);\ + (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT); \ (varPtr)->value.objPtr = NULL #define TclClearVarUndefined(varPtr) @@ -802,19 +802,19 @@ typedef struct VarInHash { (varPtr)->flags &= ~VAR_TRACE_ACTIVE #define TclSetVarNamespaceVar(varPtr) \ - if (!TclIsVarNamespaceVar(varPtr)) {\ - (varPtr)->flags |= VAR_NAMESPACE_VAR;\ - if (TclIsVarInHash(varPtr)) {\ - ((VarInHash *)(varPtr))->refCount++;\ - }\ + if (!TclIsVarNamespaceVar(varPtr)) { \ + (varPtr)->flags |= VAR_NAMESPACE_VAR; \ + if (TclIsVarInHash(varPtr)) { \ + ((VarInHash *)(varPtr))->refCount++; \ + } \ } #define TclClearVarNamespaceVar(varPtr) \ - if (TclIsVarNamespaceVar(varPtr)) {\ - (varPtr)->flags &= ~VAR_NAMESPACE_VAR;\ - if (TclIsVarInHash(varPtr)) {\ - ((VarInHash *)(varPtr))->refCount--;\ - }\ + if (TclIsVarNamespaceVar(varPtr)) { \ + (varPtr)->flags &= ~VAR_NAMESPACE_VAR; \ + if (TclIsVarInHash(varPtr)) { \ + ((VarInHash *)(varPtr))->refCount--; \ + } \ } /* @@ -832,7 +832,7 @@ typedef struct VarInHash { * MODULE_SCOPE int TclIsVarResolved(Var *varPtr); */ -#define TclVarFindHiddenArray(varPtr,arrayPtr) \ +#define TclVarFindHiddenArray(varPtr, arrayPtr) \ do { \ if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ (TclVarParentArray(varPtr) != NULL)) { \ @@ -884,7 +884,7 @@ typedef struct VarInHash { ((varPtr)->flags & VAR_DEAD_HASH) #define TclGetVarNsPtr(varPtr) \ - (TclIsVarInHash(varPtr) \ + (TclIsVarInHash(varPtr) \ ? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \ : NULL) @@ -901,36 +901,38 @@ typedef struct VarInHash { * Macros for direct variable access by TEBC. */ -#define TclIsVarTricky(varPtr,trickyFlags) \ +#define TclIsVarTricky(varPtr, trickyFlags) \ ( ((varPtr)->flags & (VAR_ARRAY|VAR_LINK|trickyFlags)) \ || (TclIsVarInHash(varPtr) \ && (TclVarParentArray(varPtr) != NULL) \ && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) -#define TclIsVarDirectReadable(varPtr) \ - ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ)) \ +#define TclIsVarDirectReadable(varPtr) \ + ( (!TclIsVarTricky(varPtr, VAR_TRACED_READ)) \ && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ - (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT)) + (!TclIsVarTricky(varPtr, VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT)) #define TclIsVarDirectUnsettable(varPtr) \ - (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH|VAR_CONSTANT)) + (!TclIsVarTricky(varPtr, \ + VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH|VAR_CONSTANT)) #define TclIsVarDirectModifyable(varPtr) \ - ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT)) \ + ( (!TclIsVarTricky(varPtr, \ + VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT)) \ && (varPtr)->value.objPtr) #define TclIsVarDirectReadable2(varPtr, arrayPtr) \ - (TclIsVarDirectReadable(varPtr) &&\ + (TclIsVarDirectReadable(varPtr) && \ (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ))) #define TclIsVarDirectWritable2(varPtr, arrayPtr) \ - (TclIsVarDirectWritable(varPtr) &&\ + (TclIsVarDirectWritable(varPtr) && \ (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_WRITE))) #define TclIsVarDirectModifyable2(varPtr, arrayPtr) \ - (TclIsVarDirectModifyable(varPtr) &&\ + (TclIsVarDirectModifyable(varPtr) && \ (!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE)))) /* @@ -1102,7 +1104,8 @@ typedef struct ActiveInterpTrace { #define TCL_TRACE_LEAVE_EXEC 2 #if TCL_MAJOR_VERSION > 8 -#define TclObjTypeHasProc(objPtr, proc) (((objPtr)->typePtr \ +#define TclObjTypeHasProc(objPtr, proc) \ + (((objPtr)->typePtr \ && ((offsetof(Tcl_ObjType, proc) < offsetof(Tcl_ObjType, version)) \ || (offsetof(Tcl_ObjType, proc) < (objPtr)->typePtr->version))) ? \ ((objPtr)->typePtr)->proc : NULL) @@ -2621,68 +2624,68 @@ typedef struct ListRep { */ /* Returns the starting slot for this listRep in the contained ListStore */ -#define ListRepStart(listRepPtr_) \ - ((listRepPtr_)->spanPtr \ - ? (listRepPtr_)->spanPtr->spanStart \ - : (listRepPtr_)->storePtr->firstUsed) +#define ListRepStart(listRepPtr) \ + ((listRepPtr)->spanPtr \ + ? (listRepPtr)->spanPtr->spanStart \ + : (listRepPtr)->storePtr->firstUsed) /* Returns the number of elements in this listRep */ -#define ListRepLength(listRepPtr_) \ - ((listRepPtr_)->spanPtr \ - ? (listRepPtr_)->spanPtr->spanLength \ - : (listRepPtr_)->storePtr->numUsed) +#define ListRepLength(listRepPtr) \ + ((listRepPtr)->spanPtr \ + ? (listRepPtr)->spanPtr->spanLength \ + : (listRepPtr)->storePtr->numUsed) /* Returns a pointer to the first slot containing this ListRep elements */ -#define ListRepElementsBase(listRepPtr_) \ - (&(listRepPtr_)->storePtr->slots[ListRepStart(listRepPtr_)]) +#define ListRepElementsBase(listRepPtr) \ + (&(listRepPtr)->storePtr->slots[ListRepStart(listRepPtr)]) /* Stores the number of elements and base address of the element array */ -#define ListRepElements(listRepPtr_, objc_, objv_) \ - (((objv_) = ListRepElementsBase(listRepPtr_)), \ - ((objc_) = ListRepLength(listRepPtr_))) +#define ListRepElements(listRepPtr, objc, objv) \ + (((objv) = ListRepElementsBase(listRepPtr)), \ + ((objc) = ListRepLength(listRepPtr))) /* Returns 1/0 whether the ListRep's ListStore is shared. */ -#define ListRepIsShared(listRepPtr_) ((listRepPtr_)->storePtr->refCount > 1) +#define ListRepIsShared(listRepPtr) ((listRepPtr)->storePtr->refCount > 1) /* Returns a pointer to the ListStore component */ -#define ListObjStorePtr(listObj_) \ - ((ListStore *)((listObj_)->internalRep.twoPtrValue.ptr1)) +#define ListObjStorePtr(listObj) \ + ((ListStore *)((listObj)->internalRep.twoPtrValue.ptr1)) /* Returns a pointer to the ListSpan component */ -#define ListObjSpanPtr(listObj_) \ - ((ListSpan *)((listObj_)->internalRep.twoPtrValue.ptr2)) +#define ListObjSpanPtr(listObj) \ + ((ListSpan *)((listObj)->internalRep.twoPtrValue.ptr2)) /* Returns the ListRep internal representaton in a Tcl_Obj */ -#define ListObjGetRep(listObj_, listRepPtr_) \ +#define ListObjGetRep(listObj, listRepPtr) \ do { \ - (listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \ - (listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_); \ + (listRepPtr)->storePtr = ListObjStorePtr(listObj); \ + (listRepPtr)->spanPtr = ListObjSpanPtr(listObj); \ } while (0) -/* Returns the length of the list */ -#define ListObjLength(listObj_, len_) \ - ((len_) = ListObjSpanPtr(listObj_) \ - ? ListObjSpanPtr(listObj_)->spanLength \ - : ListObjStorePtr(listObj_)->numUsed) +/* Retrieves the length of the list */ +#define ListObjLength(listObj, len) \ + ((len) = ListObjSpanPtr(listObj) \ + ? ListObjSpanPtr(listObj)->spanLength \ + : ListObjStorePtr(listObj)->numUsed) /* Returns the starting slot index of this list's elements in the ListStore */ -#define ListObjStart(listObj_) \ - (ListObjSpanPtr(listObj_) \ - ? ListObjSpanPtr(listObj_)->spanStart \ - : ListObjStorePtr(listObj_)->firstUsed) +#define ListObjStart(listObj) \ + (ListObjSpanPtr(listObj) \ + ? ListObjSpanPtr(listObj)->spanStart \ + : ListObjStorePtr(listObj)->firstUsed) /* Stores the element count and base address of this list's elements */ -#define ListObjGetElements(listObj_, objc_, objv_) \ - (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \ - (ListObjLength(listObj_, (objc_)))) +#define ListObjGetElements(listObj, objc, objv) \ + (((objv) = &ListObjStorePtr(listObj)->slots[ListObjStart(listObj)]), \ + (ListObjLength(listObj, (objc)))) /* * Returns 1/0 whether the internal representation (not the Tcl_Obj itself) * is shared. Note by intent this only checks for sharing of ListStore, * not spans. */ -#define ListObjRepIsShared(listObj_) \ - (ListObjStorePtr(listObj_)->refCount > 1) +#define ListObjRepIsShared(listObj) \ + (ListObjStorePtr(listObj)->refCount > 1) /* * Certain commands like concat are optimized if an existing string @@ -2699,37 +2702,37 @@ typedef struct ListRep { * and never from strings (see SetListFromAny) and thus their string * representation will always be canonical. */ -#define ListObjIsCanonical(listObj_) \ - (((listObj_)->bytes == NULL) \ - || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \ - || ListObjSpanPtr(listObj_) != NULL) +#define ListObjIsCanonical(listObj) \ + (((listObj)->bytes == NULL) \ + || (ListObjStorePtr(listObj)->flags & LISTSTORE_CANONICAL) \ + || ListObjSpanPtr(listObj) != NULL) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element - * count and base address of this list's elements in objcPtr_ and objvPtr_. + * count and base address of this list's elements in objcPtr and objvPtr. * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be * converted to a list. */ -#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ +#define TclListObjGetElements(interp, listObj, objcPtr, objvPtr) \ + ((TclHasInternalRep((listObj), &tclListType)) \ + ? ((ListObjGetElements((listObj), *(objcPtr), *(objvPtr))), \ TCL_OK) \ : Tcl_ListObjGetElements( \ - (interp_), (listObj_), (objcPtr_), (objvPtr_))) + (interp), (listObj), (objcPtr), (objvPtr))) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element - * count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the + * count in lenPtr. Returns TCL_OK on success or TCL_ERROR if the * Tcl_Obj cannot be converted to a list. */ -#define TclListObjLength(interp_, listObj_, lenPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ - : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) +#define TclListObjLength(interp, listObj, lenPtr) \ + ((TclHasInternalRep((listObj), &tclListType)) \ + ? ((ListObjLength((listObj), *(lenPtr))), TCL_OK) \ + : Tcl_ListObjLength((interp), (listObj), (lenPtr))) -#define TclListObjIsCanonical(listObj_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ListObjIsCanonical((listObj_)) \ +#define TclListObjIsCanonical(listObj) \ + ((TclHasInternalRep((listObj), &tclListType)) \ + ? ListObjIsCanonical((listObj)) \ : 0) /* @@ -2966,12 +2969,12 @@ typedef struct ProcessGlobalValue { */ #define ENCODING_PROFILE_MASK 0xFF000000 -#define ENCODING_PROFILE_GET(flags_) \ - ((flags_) & ENCODING_PROFILE_MASK) -#define ENCODING_PROFILE_SET(flags_, profile_) \ +#define ENCODING_PROFILE_GET(flags) \ + ((flags) & ENCODING_PROFILE_MASK) +#define ENCODING_PROFILE_SET(flags, profile) \ do { \ - (flags_) &= ~ENCODING_PROFILE_MASK; \ - (flags_) |= ((profile_) & ENCODING_PROFILE_MASK); \ + (flags) &= ~ENCODING_PROFILE_MASK; \ + (flags) |= ((profile) & ENCODING_PROFILE_MASK); \ } while (0) /* @@ -3215,8 +3218,8 @@ typedef struct ForIterData { } ForIterData; /* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile - * and Tcl_FindSymbol. This structure corresponds to an opaque - * typedef in tcl.h */ + * and Tcl_FindSymbol. This structure corresponds to an opaque + * typedef in tcl.h */ typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, const char* symbol); @@ -4276,21 +4279,22 @@ MODULE_SCOPE void TclpFreeAllocCache(void *); # define ALLOC_NOBJHIGH 1200 -# define TclAllocObjStorageEx(interp, objPtr) \ +# define TclAllocObjStorageEx(interp, objPtr) \ do { \ AllocCache *cachePtr; \ if (((interp) == NULL) || \ - ((cachePtr = ((Interp *)(interp))->allocCache), \ + ((cachePtr = ((Interp *) (interp))->allocCache), \ (cachePtr->numObjects == 0))) { \ (objPtr) = TclThreadAllocObj(); \ } else { \ (objPtr) = cachePtr->firstObjPtr; \ - cachePtr->firstObjPtr = (Tcl_Obj *)(objPtr)->internalRep.twoPtrValue.ptr1; \ + cachePtr->firstObjPtr = (Tcl_Obj *) \ + (objPtr)->internalRep.twoPtrValue.ptr1; \ --cachePtr->numObjects; \ } \ } while (0) -# define TclFreeObjStorageEx(interp, objPtr) \ +# define TclFreeObjStorageEx(interp, objPtr) \ do { \ AllocCache *cachePtr; \ if (((interp) == NULL) || \ @@ -4345,7 +4349,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, int line); # define TclDbNewObj(objPtr, file, line) \ - do { \ + do { \ TclIncrObjsAllocated(); \ (objPtr) = (Tcl_Obj *) \ Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \ @@ -4458,7 +4462,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, #define TclInvalidateStringRep(objPtr) \ do { \ - Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ + Tcl_Obj *_isobjPtr = (Tcl_Obj *) (objPtr); \ if (_isobjPtr->bytes != NULL) { \ if (_isobjPtr->bytes != &tclEmptyString) { \ Tcl_Free((char *)_isobjPtr->bytes); \ @@ -4958,7 +4962,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; #define TclSmallFreeEx(interp, memPtr) \ do { \ - TclFreeObjStorageEx((interp), (Tcl_Obj *)(memPtr)); \ + TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr)); \ TclIncrObjsFreed(); \ } while (0) @@ -4973,7 +4977,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; #define TclSmallFreeEx(interp, memPtr) \ do { \ - Tcl_Obj *_objPtr = (Tcl_Obj *)(memPtr); \ + Tcl_Obj *_objPtr = (Tcl_Obj *) (memPtr); \ _objPtr->bytes = NULL; \ _objPtr->typePtr = NULL; \ _objPtr->refCount = 1; \ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 5fbefbf..d3a27b7 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -196,12 +196,12 @@ struct LimitHandler { /* * Values for the LimitHandler flags field. - * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being - * processed; handlers are never to be reentered. - * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This - * should not normally be observed because when a handler is - * deleted it is also spliced out of the list of handlers, but - * even so we will be careful. + * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being + * processed; handlers are never to be reentered. + * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This + * should not normally be observed because when a handler is + * deleted it is also spliced out of the list of handlers, but + * even so we will be careful. */ #define LIMIT_HANDLER_ACTIVE 0x01 @@ -600,9 +600,9 @@ InterpInfoDeleteProc( int Tcl_InterpObjCmd( void *clientData, - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv); } @@ -610,9 +610,9 @@ Tcl_InterpObjCmd( static int NRInterpCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *childInterp; static const char *const options[] = { @@ -1007,7 +1007,7 @@ NRInterpCmd( } switch (limitType) { case LIMIT_TYPE_COMMANDS: - return ChildCommandLimitCmd(interp, childInterp, 4, objc,objv); + return ChildCommandLimitCmd(interp, childInterp, 4, objc, objv); case LIMIT_TYPE_TIME: return ChildTimeLimitCmd(interp, childInterp, 4, objc, objv); } @@ -1162,7 +1162,7 @@ static Tcl_Interp * GetInterp2( Tcl_Interp *interp, /* Default interp if no interp was specified * on the command line. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc == 2) { @@ -1197,7 +1197,7 @@ Tcl_CreateAlias( const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - Tcl_Size argc, /* How many additional arguments? */ + Tcl_Size argc, /* How many additional arguments? */ const char *const *argv) /* These are the additional args. */ { Tcl_Obj *childObjPtr, *targetObjPtr; @@ -1252,7 +1252,7 @@ Tcl_CreateAliasObj( const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - Tcl_Size objc, /* How many additional arguments? */ + Tcl_Size objc, /* How many additional arguments? */ Tcl_Obj *const objv[]) /* Argument vector. */ { Tcl_Obj *childObjPtr, *targetObjPtr; @@ -1459,7 +1459,7 @@ AliasCreate( * invoked. */ Tcl_Obj *namePtr, /* Name of alias cmd. */ Tcl_Obj *targetCmdPtr, /* Name of target cmd. */ - Tcl_Size objc, /* Additional arguments to store */ + Tcl_Size objc, /* Additional arguments to store */ Tcl_Obj *const objv[]) /* with alias. */ { Alias *aliasPtr; @@ -1759,7 +1759,7 @@ AliasList( static int AliasNRCmd( - void *clientData, /* Alias record. */ + void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ @@ -1812,7 +1812,7 @@ AliasNRCmd( int TclAliasObjCmd( - void *clientData, /* Alias record. */ + void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ @@ -1904,7 +1904,7 @@ TclAliasObjCmd( int TclLocalAliasObjCmd( - void *clientData, /* Alias record. */ + void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ @@ -1990,7 +1990,7 @@ TclLocalAliasObjCmd( static void AliasObjCmdDeleteProc( - void *clientData) /* The alias record for this alias. */ + void *clientData) /* The alias record for this alias. */ { Alias *aliasPtr = (Alias *)clientData; Target *targetPtr; @@ -2216,7 +2216,7 @@ TclSetChildCancelFlags( int Tcl_GetInterpPath( - Tcl_Interp *interp, /* Interpreter to start search from. */ + Tcl_Interp *interp, /* Interpreter to start search from. */ Tcl_Interp *targetInterp) /* Interpreter to find. */ { InterpInfo *iiPtr; @@ -2318,7 +2318,7 @@ static int ChildBgerror( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ - Tcl_Size objc, /* Set or Query. */ + Tcl_Size objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc) { @@ -2491,7 +2491,7 @@ ChildCreate( int TclChildObjCmd( - void *clientData, /* Child interpreter. */ + void *clientData, /* Child interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2501,7 +2501,7 @@ TclChildObjCmd( static int NRChildCmd( - void *clientData, /* Child interpreter. */ + void *clientData, /* Child interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2661,7 +2661,7 @@ NRChildCmd( } switch (limitType) { case LIMIT_TYPE_COMMANDS: - return ChildCommandLimitCmd(interp, childInterp, 3, objc,objv); + return ChildCommandLimitCmd(interp, childInterp, 3, objc, objv); case LIMIT_TYPE_TIME: return ChildTimeLimitCmd(interp, childInterp, 3, objc, objv); } @@ -2705,7 +2705,7 @@ NRChildCmd( static void ChildObjCmdDeleteProc( - void *clientData) /* The ChildRecord for the command. */ + void *clientData) /* The ChildRecord for the command. */ { Child *childPtr; /* Interim storage for Child record. */ Tcl_Interp *childInterp = (Tcl_Interp *)clientData; @@ -2753,7 +2753,7 @@ ChildDebugCmd( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const debugTypes[] = { @@ -2824,7 +2824,7 @@ ChildEval( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; @@ -2887,7 +2887,7 @@ static int ChildExpose( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; @@ -2931,7 +2931,7 @@ static int ChildRecursionLimit( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ - Tcl_Size objc, /* Set or Query. */ + Tcl_Size objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { Interp *iPtr; @@ -2993,7 +2993,7 @@ static int ChildHide( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; @@ -3037,10 +3037,10 @@ ChildHidden( Tcl_Interp *interp, /* Interp for data return. */ Tcl_Interp *childInterp) /* Interp whose hidden commands to query. */ { - Tcl_Obj *listObjPtr; /* Local object pointer. */ - Tcl_HashTable *hTblPtr; /* For local searches. */ - Tcl_HashEntry *hPtr; /* For local searches. */ - Tcl_HashSearch hSearch; /* For local searches. */ + Tcl_Obj *listObjPtr; /* Local object pointer. */ + Tcl_HashTable *hTblPtr; /* For local searches. */ + Tcl_HashEntry *hPtr; /* For local searches. */ + Tcl_HashSearch hSearch; /* For local searches. */ TclNewObj(listObjPtr); hTblPtr = ((Interp *) childInterp)->hiddenCmdTablePtr; @@ -3078,7 +3078,7 @@ ChildInvokeHidden( Tcl_Interp *childInterp, /* The child interpreter in which command will * be invoked. */ const char *namespaceName, /* The namespace to use, if any. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; @@ -4421,8 +4421,8 @@ static int ChildCommandLimitCmd( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Interp *childInterp, /* Interpreter being adjusted. */ - Tcl_Size consumedObjc, /* Number of args already parsed. */ - Tcl_Size objc, /* Total number of arguments. */ + Tcl_Size consumedObjc, /* Number of args already parsed. */ + Tcl_Size objc, /* Total number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { @@ -4606,11 +4606,11 @@ ChildCommandLimitCmd( static int ChildTimeLimitCmd( - Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Interp *childInterp, /* Interpreter being adjusted. */ - Tcl_Size consumedObjc, /* Number of args already parsed. */ - Tcl_Size objc, /* Total number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *childInterp, /* Interpreter being adjusted. */ + Tcl_Size consumedObjc, /* Number of args already parsed. */ + Tcl_Size objc, /* Total number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { "-command", "-granularity", "-milliseconds", "-seconds", NULL diff --git a/generic/tclLink.c b/generic/tclLink.c index 3bd855b..2fe9d16 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -36,7 +36,7 @@ typedef struct { Tcl_Size bytes; /* Size of C variable array. This is 0 when * single variables, and >0 used for array * variables. */ - Tcl_Size numElems; /* Number of elements in C variable array. + Tcl_Size numElems; /* Number of elements in C variable array. * Zero for single variables. */ int type; /* Type of link (TCL_LINK_INT, etc.). */ union { @@ -110,11 +110,11 @@ static int SetInvalidRealFromAny(Tcl_Interp *interp, */ static Tcl_ObjType invalidRealType = { - "invalidReal", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - NULL, /* updateStringProc */ - NULL, /* setFromAnyProc */ + "invalidReal", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; @@ -300,7 +300,7 @@ Tcl_LinkArray( /* * If no address is given create one and use as address the - * not needed linkPtr->lastValue + * not needed linkPtr->lastValue */ if (addr == NULL) { @@ -680,7 +680,7 @@ GetInvalidDoubleFromObj( static char * LinkTraceProc( - void *clientData, /* Contains information about the link. */ + void *clientData, /* Contains information about the link. */ Tcl_Interp *interp, /* Interpreter containing Tcl variable. */ TCL_UNUSED(const char *) /*name1*/, TCL_UNUSED(const char *) /*name2*/, @@ -809,7 +809,7 @@ LinkTraceProc( TCL_GLOBAL_ONLY); return (char *) "linked variable is read-only"; } - valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY); + valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName, NULL, TCL_GLOBAL_ONLY); if (valueObj == NULL) { /* * This shouldn't ever happen. @@ -891,7 +891,7 @@ LinkTraceProc( if (GetInt(objv[i], varPtr)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have integer values"; + return (char *) "variable array must have integer values"; } } } else { @@ -959,7 +959,7 @@ LinkTraceProc( if (Tcl_GetBooleanFromObj(NULL, objv[i], varPtr) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have boolean value"; + return (char *) "variable array must have boolean value"; } } } else { @@ -978,10 +978,10 @@ LinkTraceProc( if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetInt(objv[i], &valueInt) - || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) { + || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have char value"; + return (char *) "variable array must have char value"; } linkPtr->lastValue.cPtr[i] = (char) valueInt; } @@ -1000,7 +1000,7 @@ LinkTraceProc( if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetInt(objv[i], &valueInt) - || !InRange(0, valueInt, (int)UCHAR_MAX)) { + || !InRange(0, valueInt, (int)UCHAR_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) @@ -1027,7 +1027,7 @@ LinkTraceProc( || !InRange(SHRT_MIN, valueInt, SHRT_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have short value"; + return (char *) "variable array must have short value"; } linkPtr->lastValue.sPtr[i] = (short) valueInt; } @@ -1046,10 +1046,10 @@ LinkTraceProc( if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetInt(objv[i], &valueInt) - || !InRange(0, valueInt, (int)USHRT_MAX)) { + || !InRange(0, valueInt, (int)USHRT_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) + return (char *) "variable array must have unsigned short value"; } linkPtr->lastValue.usPtr[i] = (unsigned short) valueInt; @@ -1073,7 +1073,7 @@ LinkTraceProc( || !InRange(0, valueWide, (Tcl_WideInt)UINT_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) + return (char *) "variable array must have unsigned int value"; } linkPtr->lastValue.uiPtr[i] = (unsigned int) valueWide; @@ -1095,7 +1095,7 @@ LinkTraceProc( if (GetUWide(objv[i], &valueUWide)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) + return (char *) "variable array must have unsigned wide int value"; } linkPtr->lastValue.uwPtr[i] = valueUWide; @@ -1115,10 +1115,10 @@ LinkTraceProc( for (i=0; i < objc; i++) { if (GetDouble(objv[i], &valueDouble) && !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX) - && !IsSpecial(valueDouble)) { + && !IsSpecial(valueDouble)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have float value"; + return (char *) "variable array must have float value"; } linkPtr->lastValue.fPtr[i] = (float) valueDouble; } diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 1bb3587..0615361 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -39,36 +39,36 @@ #ifdef ENABLE_LIST_ASSERTS -#define LIST_ASSERT(cond_) assert(cond_) +#define LIST_ASSERT(cond) assert(cond) /* * LIST_INDEX_ASSERT is to catch errors with negative indices and counts * being passed AFTER validation. On Tcl9 length types are unsigned hence * the checks against LIST_MAX. On Tcl8 length types are signed hence the * also checks against 0. */ -#define LIST_INDEX_ASSERT(idxarg_) \ - do { \ - Tcl_Size idx_ = (idxarg_); /* To guard against ++ etc. */ \ - LIST_ASSERT(idx_ >= 0 && idx_ < LIST_MAX); \ +#define LIST_INDEX_ASSERT(idxarg) \ + do { \ + Tcl_Size idx = (idxarg); /* To guard against ++ etc. */ \ + LIST_ASSERT(idx >= 0 && idx < LIST_MAX); \ } while (0) /* Ditto for counts except upper limit is different */ -#define LIST_COUNT_ASSERT(countarg_) \ - do { \ - Tcl_Size count_ = (countarg_); /* To guard against ++ etc. */ \ - LIST_ASSERT(count_ >= 0 && count_ <= LIST_MAX); \ +#define LIST_COUNT_ASSERT(countarg) \ + do { \ + Tcl_Size count = (countarg); /* To guard against ++ etc. */ \ + LIST_ASSERT(count >= 0 && count <= LIST_MAX); \ } while (0) #else -#define LIST_ASSERT(cond_) ((void) 0) -#define LIST_INDEX_ASSERT(idx_) ((void) 0) -#define LIST_COUNT_ASSERT(count_) ((void) 0) +#define LIST_ASSERT(cond) ((void) 0) +#define LIST_INDEX_ASSERT(idx) ((void) 0) +#define LIST_COUNT_ASSERT(count) ((void) 0) #endif /* Checks for when caller should have already converted to internal list type */ -#define LIST_ASSERT_TYPE(listObj_) \ - LIST_ASSERT(TclHasInternalRep((listObj_), &tclListType)) +#define LIST_ASSERT_TYPE(listObj) \ + LIST_ASSERT(TclHasInternalRep((listObj), &tclListType)) /* * If ENABLE_LIST_INVARIANTS is enabled (-DENABLE_LIST_INVARIANTS from the @@ -78,9 +78,10 @@ * invoke ListRepValidate directly even without ENABLE_LIST_INVARIANTS. */ #ifdef ENABLE_LIST_INVARIANTS -#define LISTREP_CHECK(listRepPtr_) ListRepValidate(listRepPtr_, __FILE__, __LINE__) +#define LISTREP_CHECK(listRepPtr) \ + ListRepValidate(listRepPtr, __FILE__, __LINE__) #else -#define LISTREP_CHECK(listRepPtr_) (void) 0 +#define LISTREP_CHECK(listRepPtr) (void) 0 #endif /* @@ -111,37 +112,40 @@ #define LISTREP_SPACE_ONLY_BACK 0x00000008 #define LISTREP_SPACE_FAVOR_NONE \ (LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK) -#define LISTREP_SPACE_FLAGS \ +#define LISTREP_SPACE_FLAGS \ (LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK \ | LISTREP_SPACE_ONLY_BACK) /* * Prototypes for non-inline static functions defined later in this file: */ -static int MemoryAllocationError(Tcl_Interp *, size_t size); -static int ListLimitExceededError(Tcl_Interp *); -static ListStore *ListStoreNew(Tcl_Size objc, Tcl_Obj *const objv[], int flags); -static int ListRepInit(Tcl_Size objc, Tcl_Obj *const objv[], int flags, ListRep *); -static int ListRepInitAttempt(Tcl_Interp *, - Tcl_Size objc, - Tcl_Obj *const objv[], - ListRep *); -static void ListRepClone(ListRep *fromRepPtr, ListRep *toRepPtr, int flags); -static void ListRepUnsharedFreeUnreferenced(const ListRep *repPtr); -static int TclListObjGetRep(Tcl_Interp *, Tcl_Obj *listPtr, ListRep *repPtr); -static void ListRepRange(ListRep *srcRepPtr, - Tcl_Size rangeStart, - Tcl_Size rangeEnd, - int preserveSrcRep, - ListRep *rangeRepPtr); -static ListStore *ListStoreReallocate(ListStore *storePtr, Tcl_Size numSlots); -static void ListRepValidate(const ListRep *repPtr, const char *file, - int lineNum); -static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void FreeListInternalRep(Tcl_Obj *listPtr); -static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -static void UpdateStringOfList(Tcl_Obj *listPtr); -static Tcl_Size ListLength(Tcl_Obj *listPtr); +static int MemoryAllocationError(Tcl_Interp *, size_t size); +static int ListLimitExceededError(Tcl_Interp *); +static ListStore * ListStoreNew(Tcl_Size objc, Tcl_Obj *const objv[], + int flags); +static int ListRepInit(Tcl_Size objc, Tcl_Obj *const objv[], + int flags, ListRep *); +static int ListRepInitAttempt(Tcl_Interp *, + Tcl_Size objc, Tcl_Obj *const objv[], ListRep *); +static void ListRepClone(ListRep *fromRepPtr, ListRep *toRepPtr, + int flags); +static void ListRepUnsharedFreeUnreferenced(const ListRep *repPtr); +static int TclListObjGetRep(Tcl_Interp *, Tcl_Obj *listPtr, + ListRep *repPtr); +static void ListRepRange(ListRep *srcRepPtr, + Tcl_Size rangeStart, + Tcl_Size rangeEnd, + int preserveSrcRep, + ListRep *rangeRepPtr); +static ListStore * ListStoreReallocate(ListStore *storePtr, + Tcl_Size numSlots); +static void ListRepValidate(const ListRep *repPtr, + const char *file, int lineNum); +static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void FreeListInternalRep(Tcl_Obj *listPtr); +static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void UpdateStringOfList(Tcl_Obj *listPtr); +static Tcl_Size ListLength(Tcl_Obj *listPtr); /* * The structure below defines the list Tcl object type by means of functions @@ -160,25 +164,26 @@ const Tcl_ObjType tclListType = { }; /* Macros to manipulate the List internal rep */ -#define ListRepIncrRefs(repPtr_) \ - do { \ - (repPtr_)->storePtr->refCount++; \ - if ((repPtr_)->spanPtr) { \ - (repPtr_)->spanPtr->refCount++; \ - } \ +#define ListRepIncrRefs(repPtr) \ + do { \ + (repPtr)->storePtr->refCount++; \ + if ((repPtr)->spanPtr) { \ + (repPtr)->spanPtr->refCount++; \ + } \ } while (0) /* Returns number of free unused slots at the back of the ListRep's ListStore */ -#define ListRepNumFreeTail(repPtr_) \ - ((repPtr_)->storePtr->numAllocated \ - - ((repPtr_)->storePtr->firstUsed + (repPtr_)->storePtr->numUsed)) +#define ListRepNumFreeTail(repPtr) \ + ((repPtr)->storePtr->numAllocated \ + - ((repPtr)->storePtr->firstUsed + (repPtr)->storePtr->numUsed)) /* Returns number of free unused slots at the front of the ListRep's ListStore */ -#define ListRepNumFreeHead(repPtr_) ((repPtr_)->storePtr->firstUsed) +#define ListRepNumFreeHead(repPtr) \ + ((repPtr)->storePtr->firstUsed) -/* Returns a pointer to the slot corresponding to list index listIdx_ */ -#define ListRepSlotPtr(repPtr_, listIdx_) \ - (&(repPtr_)->storePtr->slots[ListRepStart(repPtr_) + (listIdx_)]) +/* Returns a pointer to the slot corresponding to list index listIdx */ +#define ListRepSlotPtr(repPtr, listIdx) \ + (&(repPtr)->storePtr->slots[ListRepStart(repPtr) + (listIdx)]) /* * Macros to replace the internal representation in a Tcl_Obj. There are @@ -199,26 +204,26 @@ const Tcl_ObjType tclListType = { * passed ListRep) and frees it first. Additionally invalidates the string * representation. Generally used when modifying a Tcl_Obj value. */ -#define ListObjStompRep(objPtr_, repPtr_) \ - do { \ - (objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \ - (objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr; \ - (objPtr_)->typePtr = &tclListType; \ +#define ListObjStompRep(objPtr, repPtr) \ + do { \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (repPtr)->storePtr; \ + (objPtr)->internalRep.twoPtrValue.ptr2 = (repPtr)->spanPtr; \ + (objPtr)->typePtr = &tclListType; \ } while (0) -#define ListObjOverwriteRep(objPtr_, repPtr_) \ - do { \ - ListRepIncrRefs(repPtr_); \ - ListObjStompRep(objPtr_, repPtr_); \ +#define ListObjOverwriteRep(objPtr, repPtr) \ + do { \ + ListRepIncrRefs(repPtr); \ + ListObjStompRep(objPtr, repPtr); \ } while (0) -#define ListObjReplaceRepAndInvalidate(objPtr_, repPtr_) \ - do { \ - /* Note order important, don't use ListObjOverwriteRep! */ \ - ListRepIncrRefs(repPtr_); \ - TclFreeInternalRep(objPtr_); \ - TclInvalidateStringRep(objPtr_); \ - ListObjStompRep(objPtr_, repPtr_); \ +#define ListObjReplaceRepAndInvalidate(objPtr, repPtr) \ + do { \ + /* Note order important, don't use ListObjOverwriteRep! */ \ + ListRepIncrRefs(repPtr); \ + TclFreeInternalRep(objPtr); \ + TclInvalidateStringRep(objPtr); \ + ListObjStompRep(objPtr, repPtr); \ } while (0) /* @@ -239,8 +244,8 @@ const Tcl_ObjType tclListType = { */ static inline ListSpan * ListSpanNew( - Tcl_Size firstSlot, /* Starting slot index of the span */ - Tcl_Size numSlots) /* Number of slots covered by the span */ + Tcl_Size firstSlot, /* Starting slot index of the span */ + Tcl_Size numSlots) /* Number of slots covered by the span */ { ListSpan *spanPtr = (ListSpan *) Tcl_Alloc(sizeof(*spanPtr)); spanPtr->refCount = 0; @@ -266,7 +271,8 @@ ListSpanNew( *------------------------------------------------------------------------ */ static inline void -ListSpanDecrRefs(ListSpan *spanPtr) +ListSpanDecrRefs( + ListSpan *spanPtr) { if (spanPtr->refCount <= 1) { Tcl_Free(spanPtr); @@ -297,9 +303,10 @@ ListSpanDecrRefs(ListSpan *spanPtr) */ static inline int ListSpanMerited( - Tcl_Size length, /* Length of the proposed span */ - Tcl_Size usedStorageLength, /* Number of slots currently in used */ - Tcl_Size allocatedStorageLength) /* Length of the currently allocation */ + Tcl_Size length, /* Length of the proposed span. */ + Tcl_Size usedStorageLength, /* Number of slots currently in use. */ + Tcl_Size allocatedStorageLength) + /* Length of the current allocation. */ { /* * Possible optimizations for future consideration @@ -343,7 +350,8 @@ ListSpanMerited( *------------------------------------------------------------------------ */ static inline void -ListRepFreeUnreferenced(const ListRep *repPtr) +ListRepFreeUnreferenced( + const ListRep *repPtr) { if (! ListRepIsShared(repPtr) && repPtr->spanPtr) { /* T:listrep-1.5.1 */ @@ -368,9 +376,9 @@ ListRepFreeUnreferenced(const ListRep *repPtr) */ static inline void ObjArrayIncrRefs( - Tcl_Obj * const *objv, /* Pointer to the array */ - Tcl_Size startIdx, /* Starting index of subarray within objv */ - Tcl_Size count) /* Number of elements in the subarray */ + Tcl_Obj *const *objv, /* Pointer to the array */ + Tcl_Size startIdx, /* Starting index of subarray within objv */ + Tcl_Size count) /* Number of elements in the subarray */ { Tcl_Obj *const *end; LIST_INDEX_ASSERT(startIdx); @@ -400,9 +408,9 @@ ObjArrayIncrRefs( */ static inline void ObjArrayDecrRefs( - Tcl_Obj * const *objv, /* Pointer to the array */ - Tcl_Size startIdx, /* Starting index of subarray within objv */ - Tcl_Size count) /* Number of elements in the subarray */ + Tcl_Obj *const *objv, /* Pointer to the array */ + Tcl_Size startIdx, /* Starting index of subarray within objv */ + Tcl_Size count) /* Number of elements in the subarray */ { Tcl_Obj * const *end; LIST_INDEX_ASSERT(startIdx); @@ -432,9 +440,9 @@ ObjArrayDecrRefs( */ static inline void ObjArrayCopy( - Tcl_Obj **to, /* Destination */ - Tcl_Size count, /* Number of pointers to copy */ - Tcl_Obj *const from[]) /* Source array of Tcl_Obj* */ + Tcl_Obj **to, /* Destination */ + Tcl_Size count, /* Number of pointers to copy */ + Tcl_Obj *const from[]) /* Source array of Tcl_Obj* */ { Tcl_Obj **end; LIST_COUNT_ASSERT(count); @@ -463,8 +471,8 @@ ObjArrayCopy( */ static int MemoryAllocationError( - Tcl_Interp *interp, /* Interpreter for error message. May be NULL */ - size_t size) /* Size of attempted allocation that failed */ + Tcl_Interp *interp, /* Interpreter for error message. May be NULL */ + size_t size) /* Size of attempted allocation that failed */ { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -492,12 +500,12 @@ MemoryAllocationError( *------------------------------------------------------------------------ */ static int -ListLimitExceededError(Tcl_Interp *interp) +ListLimitExceededError( + Tcl_Interp *interp) { if (interp != NULL) { - Tcl_SetObjResult( - interp, - Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "max length of a Tcl list exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); } return TCL_ERROR; @@ -523,7 +531,9 @@ ListLimitExceededError(Tcl_Interp *interp) *------------------------------------------------------------------------ */ static inline void -ListRepUnsharedShiftDown(ListRep *repPtr, Tcl_Size shiftCount) +ListRepUnsharedShiftDown( + ListRep *repPtr, + Tcl_Size shiftCount) { ListStore *storePtr; @@ -578,7 +588,9 @@ ListRepUnsharedShiftDown(ListRep *repPtr, Tcl_Size shiftCount) */ #if 0 static inline void -ListRepUnsharedShiftUp(ListRep *repPtr, Tcl_Size shiftCount) +ListRepUnsharedShiftUp( + ListRep *repPtr, + Tcl_Size shiftCount) { ListStore *storePtr; @@ -624,19 +636,22 @@ ListRepUnsharedShiftUp(ListRep *repPtr, Tcl_Size shiftCount) *------------------------------------------------------------------------ */ static void -ListRepValidate(const ListRep *repPtr, const char *file, int lineNum) +ListRepValidate( + const ListRep *repPtr, + const char *file, + int lineNum) { ListStore *storePtr = repPtr->storePtr; const char *condition; (void)storePtr; /* To stop gcc from whining about unused vars */ -#define INVARIANT(cond_) \ - do { \ - if (!(cond_)) { \ - condition = #cond_; \ - goto failure; \ - } \ +#define INVARIANT(cond) \ + do { \ + if (!(cond)) { \ + condition = #cond; \ + goto failure; \ + } \ } while (0) /* Separate each condition so line number gives exact reason for failure */ @@ -667,9 +682,7 @@ ListRepValidate(const ListRep *repPtr, const char *file, int lineNum) failure: Tcl_Panic("List internal failure in %s line %d. Condition: %s", - file, - lineNum, - condition); + file, lineNum, condition); } /* @@ -689,7 +702,9 @@ failure: *------------------------------------------------------------------------ */ void -TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj) +TclListObjValidate( + Tcl_Interp *interp, + Tcl_Obj *listObj) { ListRep listRep; if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { @@ -709,14 +724,14 @@ TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj) * in that array. If objv==NULL, initalize 0 elements, with space * to add objc more. * - * Normally the function allocates the exact space requested unless - * the flags arguments has any LISTREP_SPACE_* - * bits set. See the comments for those #defines. + * Normally the function allocates the exact space requested unless + * the flags arguments has any LISTREP_SPACE_* + * bits set. See the comments for those #defines. * * Results: - * On success, a pointer to the allocated ListStore is returned. - * On allocation failure, panics if LISTREP_PANIC_ON_FAIL is set in - * flags; otherwise returns NULL. + * On success, a pointer to the allocated ListStore is returned. + * On allocation failure, panics if LISTREP_PANIC_ON_FAIL is set in + * flags; otherwise returns NULL. * * Side effects: * The ref counts of the elements in objv are incremented on success @@ -840,24 +855,24 @@ ListStoreReallocate( * * ListRepInit -- * - * Initializes a ListRep to hold a list internal representation - * with space for objc elements. + * Initializes a ListRep to hold a list internal representation + * with space for objc elements. * - * objc must be > 0. If objv!=NULL, initializes with the first objc - * values in that array. If objv==NULL, initalize list internal rep to - * have 0 elements, with space to add objc more. + * objc must be > 0. If objv!=NULL, initializes with the first objc + * values in that array. If objv==NULL, initalize list internal rep to + * have 0 elements, with space to add objc more. * * Normally the function allocates the exact space requested unless * the flags arguments has one of the LISTREP_SPACE_* bits set. * See the comments for those #defines. * - * The reference counts of the ListStore and ListSpan (if present) + * The reference counts of the ListStore and ListSpan (if present) * pointed to by the initialized repPtr are set to zero. * Caller has to manage them as necessary. * * Results: - * On success, TCL_OK is returned with *listRepPtr initialized. - * On failure, panics if LISTREP_PANIC_ON_FAIL is set in flags; otherwise + * On success, TCL_OK is returned with *listRepPtr initialized. + * On failure, panics if LISTREP_PANIC_ON_FAIL is set in flags; otherwise * returns TCL_ERROR with *listRepPtr fields set to NULL. * * Side effects: @@ -905,12 +920,12 @@ ListRepInit( * be > 0). This function only adds error messages to the interpreter if * not NULL. * - * The reference counts of the ListStore and ListSpan (if present) + * The reference counts of the ListStore and ListSpan (if present) * pointed to by the initialized repPtr are set to zero. * Caller has to manage them as necessary. * * Results: - * On success, TCL_OK is returned with *listRepPtr initialized. + * On success, TCL_OK is returned with *listRepPtr initialized. * On allocation failure, returnes TCL_ERROR with an error message * in the interpreter if non-NULL. * @@ -1241,16 +1256,16 @@ TclNewListObj2( * Side effects: * The possible conversion of the object referenced by listPtr * to a list object. *repPtr is initialized to the internal rep - * if result is TCL_OK, or set to NULL on error. + * if result is TCL_OK, or set to NULL on error. *---------------------------------------------------------------------- */ static int TclListObjGetRep( - Tcl_Interp *interp, /* Used to report errors if not NULL. */ - Tcl_Obj *listObj, /* List object for which an element array is - * to be returned. */ - ListRep *repPtr) /* Location to store descriptor */ + Tcl_Interp *interp, /* Used to report errors if not NULL. */ + Tcl_Obj *listObj, /* List object for which an element array is + * to be returned. */ + ListRep *repPtr) /* Location to store descriptor */ { if (!TclHasInternalRep(listObj, &tclListType)) { int result; @@ -1373,18 +1388,18 @@ TclListObjCopy( * None. * * Side effects: - * The ListStore and ListSpan referenced by in the returned ListRep - * may or may not be the same as those passed in. For example, the - * ListStore may differ because the range is small enough that a new - * ListStore is more memory-optimal. The ListSpan may differ because - * it is NULL or shared. Regardless, reference counts on the returned - * values are not incremented. Generally, ListObjReplaceRepAndInvalidate - * may be used to store the new ListRep back into an object or a - * ListRepIncrRefs followed by ListRepDecrRefs to free in case of errors. + * The ListStore and ListSpan referenced by in the returned ListRep + * may or may not be the same as those passed in. For example, the + * ListStore may differ because the range is small enough that a new + * ListStore is more memory-optimal. The ListSpan may differ because + * it is NULL or shared. Regardless, reference counts on the returned + * values are not incremented. Generally, ListObjReplaceRepAndInvalidate + * may be used to store the new ListRep back into an object or a + * ListRepIncrRefs followed by ListRepDecrRefs to free in case of errors. * Any other use should be carefully reconsidered. - * TODO WARNING:- this is an awkward interface and easy for caller - * to get wrong. Mostly due to refcount combinations. Perhaps passing - * in the source listObj instead of source listRep might simplify. + * TODO WARNING:- this is an awkward interface and easy for caller + * to get wrong. Mostly due to refcount combinations. Perhaps passing + * in the source listObj instead of source listRep might simplify. * *------------------------------------------------------------------------ */ @@ -1529,7 +1544,7 @@ ListRepRange( } memmove(&srcRepPtr->storePtr->slots[0], &srcRepPtr->storePtr - ->slots[srcRepPtr->storePtr->firstUsed + rangeStart], + ->slots[srcRepPtr->storePtr->firstUsed + rangeStart], rangeLen * sizeof(Tcl_Obj *)); srcRepPtr->storePtr->firstUsed = 0; srcRepPtr->storePtr->numUsed = rangeLen; @@ -1557,11 +1572,11 @@ ListRepRange( * TclListObjRange -- * * Makes a slice of a list value. - * *listObj must be known to be a valid list. + * *listObj must be known to be a valid list. * * Results: * Returns a pointer to the sliced list. - * This may be a new object or the same object if not shared. + * This may be a new object or the same object if not shared. * Returns NULL if passed listObj was not a list and could not be * converted to one. * @@ -1726,9 +1741,9 @@ Tcl_ListObjAppendList( * * TclListObjAppendElements -- * - * Appends multiple elements to a Tcl_Obj list object. If - * the passed Tcl_Obj is not a list object, it will be converted to one - * and an error raised if the conversion fails. + * Appends multiple elements to a Tcl_Obj list object. If + * the passed Tcl_Obj is not a list object, it will be converted to one + * and an error raised if the conversion fails. * * The Tcl_Obj must not be shared though the internal representation * may be. @@ -1958,7 +1973,7 @@ Tcl_ListObjIndex( return TCL_OK; } - int hasAbstractList = TclObjTypeHasProc(listObj,indexProc) != 0; + int hasAbstractList = TclObjTypeHasProc(listObj, indexProc) != 0; if (hasAbstractList) { return TclObjTypeIndex(interp, listObj, index, objPtrPtr); } @@ -2000,9 +2015,9 @@ Tcl_ListObjIndex( #undef Tcl_ListObjLength int Tcl_ListObjLength( - Tcl_Interp *interp, /* Used to report errors if not NULL. */ - Tcl_Obj *listObj, /* List object whose #elements to return. */ - Tcl_Size *lenPtr) /* The resulting length is stored here. */ + Tcl_Interp *interp, /* Used to report errors if not NULL. */ + Tcl_Obj *listObj, /* List object whose #elements to return. */ + Tcl_Size *lenPtr) /* The resulting length is stored here. */ { ListRep listRep; @@ -2741,7 +2756,7 @@ TclLindexFlat( * * Core of the 'lset' command when objc == 4. Objv[2] may be either a * scalar index or a list of indices. - * It also handles 'lpop' when given a NULL value. + * It also handles 'lpop' when given a NULL value. * * Results: * Returns the new value of the list variable, or NULL if there was an @@ -2767,10 +2782,10 @@ TclLsetList( Tcl_Obj *indexArgObj, /* Index or index-list arg to 'lset'. */ Tcl_Obj *valueObj) /* Value arg to 'lset' or NULL to 'lpop'. */ { - Tcl_Size indexCount = 0; /* Number of indices in the index list. */ + Tcl_Size indexCount = 0; /* Number of indices in the index list. */ Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */ Tcl_Obj *retValueObj; /* Pointer to the list to be returned. */ - Tcl_Size index; /* Current index in the list - discarded. */ + Tcl_Size index; /* Current index in the list - discarded. */ Tcl_Obj *indexListCopy; /* @@ -2797,7 +2812,7 @@ TclLsetList( } else { - indexListCopy = TclListObjCopy(NULL,indexArgObj); + indexListCopy = TclListObjCopy(NULL, indexArgObj); if (!indexListCopy) { /* * indexArgPtr designates something that is neither an index nor a @@ -2836,7 +2851,7 @@ TclLsetList( * TclLsetFlat -- * * Core engine of the 'lset' command. - * It also handles 'lpop' when given a NULL value. + * It also handles 'lpop' when given a NULL value. * * Results: * Returns the new value of the list variable, or NULL if an error @@ -2957,11 +2972,11 @@ TclLsetFlat( } indexArray++; - /* - * Special case 0-length lists. The Tcl indexing function treat - * will return any value beyond length as TCL_SIZE_MAX for this - * case. - */ + /* + * Special case 0-length lists. The Tcl indexing function treat + * will return any value beyond length as TCL_SIZE_MAX for this + * case. + */ if ((index == TCL_SIZE_MAX) && (elemCount == 0)) { index = 0; } @@ -2971,7 +2986,7 @@ TclLsetFlat( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "index \"%s\" out of range", - Tcl_GetString(indexArray[-1]))); + Tcl_GetString(indexArray[-1]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" "OUTOFRANGE", (void *)NULL); } @@ -3143,7 +3158,7 @@ TclListObjSetElement( * element. */ { ListRep listRep; - Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */ + Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */ Tcl_Size elemCount; /* Number of elements in the list. */ /* Ensure that the listObj parameter designates an unshared list. */ @@ -3335,7 +3350,7 @@ SetListFromAny( Tcl_IncrRefCount(valuePtr); Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } - } else if (TclObjTypeHasProc(objPtr,indexProc)) { + } else if (TclObjTypeHasProc(objPtr, indexProc)) { Tcl_Size elemCount, i; elemCount = TclObjTypeLength(objPtr); diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index f4d92cd..a2a90d6 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -58,8 +58,7 @@ static void RebuildLiteralTable(LiteralTable *tablePtr); void TclInitLiteralTable( - LiteralTable *tablePtr) - /* Pointer to table structure, which is + LiteralTable *tablePtr) /* Pointer to table structure, which is * supplied by the caller. */ { #if (TCL_SMALL_HASH_TABLE != 4) @@ -176,11 +175,11 @@ TclDeleteLiteralTable( Tcl_Obj * TclCreateLiteral( Interp *iPtr, - const char *bytes, /* The start of the string. Note that this is + const char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ - Tcl_Size length, /* Number of bytes in the string. */ - size_t hash, /* The string's hash. If the value is - * TCL_INDEX_NONE, it will be computed here. */ + Tcl_Size length, /* Number of bytes in the string. */ + size_t hash, /* The string's hash. If the value is + * TCL_INDEX_NONE, it will be computed here. */ int *newPtr, Namespace *nsPtr, int flags, @@ -389,12 +388,12 @@ TclFetchLiteral( int /* Do NOT change this type. Should not be wider than TclEmitPush operand*/ TclRegisterLiteral( - void *ePtr, /* Points to the CompileEnv in whose object + 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 + const char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ - Tcl_Size length, /* Number of bytes in the string. If -1, the + Tcl_Size length, /* Number of bytes in the string. If -1, the * string consists of all bytes up to the * first null character. */ int flags) /* If LITERAL_ON_HEAP then the caller already @@ -507,7 +506,7 @@ 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 + Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal * that was previously created by a call to * TclRegisterLiteral. */ { @@ -553,7 +552,7 @@ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - CompileEnv *envPtr,/* Points to CompileEnv whose literal array + CompileEnv *envPtr, /* Points to CompileEnv whose literal array * contains the entry being hidden. */ int index) /* The index of the entry in the literal * array. */ @@ -617,7 +616,7 @@ TclHideLiteral( int TclAddLiteralObj( - CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + 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 @@ -670,7 +669,7 @@ TclAddLiteralObj( static size_t AddLocalLiteralEntry( - CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + 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. */ @@ -748,7 +747,7 @@ AddLocalLiteralEntry( static void ExpandLocalLiteralArray( - CompileEnv *envPtr)/* Points to the CompileEnv whose object array + CompileEnv *envPtr) /* Points to the CompileEnv whose object array * must be enlarged. */ { /* @@ -830,7 +829,7 @@ 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 + Tcl_Obj *objPtr) /* Points to a literal object that was * previously created by a call to * TclRegisterLiteral. */ { @@ -910,8 +909,8 @@ TclReleaseLiteral( static size_t HashString( - const char *string, /* String for which to compute hash value. */ - size_t length) /* Number of bytes in the string. */ + const char *string, /* String for which to compute hash value. */ + size_t length) /* Number of bytes in the string. */ { size_t result = 0; @@ -974,8 +973,7 @@ HashString( static void RebuildLiteralTable( - LiteralTable *tablePtr) - /* Local or global table to enlarge. */ + LiteralTable *tablePtr) /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; LiteralEntry **oldChainPtr, **newChainPtr; diff --git a/generic/tclLoad.c b/generic/tclLoad.c index c5a181d..b336f5c 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -156,7 +156,8 @@ Tcl_LoadObjCmd( &index) != TCL_OK) { return TCL_ERROR; } - ++objv; --objc; + ++objv; + --objc; if (LOAD_GLOBAL == index) { flags |= TCL_LOAD_GLOBAL; } else if (LOAD_LAZY == index) { @@ -993,7 +994,7 @@ Tcl_StaticLibrary( * already been loaded into the given * interpreter by calling the appropriate init * proc. */ - const char *prefix, /* Prefix. */ + const char *prefix, /* Prefix. */ Tcl_LibraryInitProc *initProc, /* Function to call to incorporate this * library into a trusted interpreter. */ @@ -1185,7 +1186,7 @@ TclGetLoadedLibraries( static void LoadCleanupProc( - TCL_UNUSED(void *), /* Pointer to first InterpLibrary structure + TCL_UNUSED(void *), /* Pointer to first InterpLibrary structure * for interp. */ Tcl_Interp *interp) { @@ -1198,7 +1199,7 @@ LoadCleanupProc( break; } libraryPtr = ipPtr->libraryPtr; - UnloadLibrary(interp, interp, libraryPtr, 0 ,"", 1); + UnloadLibrary(interp, interp, libraryPtr, 0, "", 1); } } diff --git a/generic/tclMain.c b/generic/tclMain.c index a7cb7fb..a9af9d7 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -276,7 +276,7 @@ Tcl_SourceRCFile( TCL_NORETURN void Tcl_MainEx( - Tcl_Size argc, /* Number of arguments. */ + Tcl_Size argc, /* Number of arguments. */ TCHAR **argv, /* Array of argument strings. */ Tcl_AppInitProc *appInitProc, /* Application-specific initialization @@ -739,7 +739,7 @@ TclFullFinalizationRequested(void) static void StdinProc( - void *clientData, /* The state of interactive cmd line */ + void *clientData, /* The state of interactive cmd line */ TCL_UNUSED(int) /*mask*/) { int code; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index eebf6aa..24eb14e 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -77,9 +77,9 @@ static int DoImport(Tcl_Interp *interp, const char *cmdName, const char *pattern, Namespace *importNsPtr, int allowOverwrite); static void DupNsNameInternalRep(Tcl_Obj *objPtr,Tcl_Obj *copyPtr); -static char * ErrorCodeRead(void *clientData,Tcl_Interp *interp, +static char * ErrorCodeRead(void *clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); -static char * ErrorInfoRead(void *clientData,Tcl_Interp *interp, +static char * ErrorInfoRead(void *clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static char * EstablishErrorCodeTraces(void *clientData, Tcl_Interp *interp, const char *name1, @@ -90,8 +90,7 @@ static char * EstablishErrorInfoTraces(void *clientData, static void FreeNsNameInternalRep(Tcl_Obj *objPtr); static int GetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); -static int InvokeImportedNRCmd(void *clientData, - Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc InvokeImportedNRCmd; static Tcl_ObjCmdProc NamespaceChildrenCmd; static Tcl_ObjCmdProc NamespaceCodeCmd; static Tcl_ObjCmdProc NamespaceCurrentCmd; @@ -653,7 +652,7 @@ Tcl_CreateNamespace( const char *name, /* Name for the new namespace. May be a * qualified name with names of ancestor * namespaces separated by "::"s. */ - void *clientData, /* One-word value to store with namespace. */ + void *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 @@ -1178,7 +1177,7 @@ TclDeleteNamespaceChildren( void TclTeardownNamespace( - Namespace *nsPtr) /* Points to the namespace to be dismantled + Namespace *nsPtr) /* Points to the namespace to be dismantled * and unlinked from its parent. */ { Interp *iPtr = (Interp *) nsPtr->interp; @@ -1316,7 +1315,7 @@ TclTeardownNamespace( static void NamespaceFree( - Namespace *nsPtr) /* Points to the namespace to free. */ + Namespace *nsPtr) /* Points to the namespace to free. */ { /* * Most of the namespace's contents are freed when the namespace is @@ -1615,7 +1614,7 @@ Tcl_Import( * want absence of the command to be a failure case. */ - if (Tcl_FindCommand(interp,"auto_import",NULL,TCL_GLOBAL_ONLY) != NULL) { + if (Tcl_FindCommand(interp, "auto_import", NULL, TCL_GLOBAL_ONLY) != NULL) { Tcl_Obj *objv[2]; int result; @@ -1640,7 +1639,7 @@ Tcl_Import( */ if (strlen(pattern) == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern", -1)); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", (char *)NULL); return TCL_ERROR; } @@ -2035,7 +2034,7 @@ TclGetOriginalCommand( static int InvokeImportedNRCmd( - void *clientData, /* Points to the imported command's + void *clientData, /* Points to the imported command's * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -2050,7 +2049,7 @@ InvokeImportedNRCmd( int TclInvokeImportedCmd( - void *clientData, /* Points to the imported command's + void *clientData, /* Points to the imported command's * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -2083,7 +2082,7 @@ TclInvokeImportedCmd( static void DeleteImportedCmd( - void *clientData) /* Points to the imported command's + void *clientData) /* Points to the imported command's * ImportedCmdData structure. */ { ImportedCmdData *dataPtr = (ImportedCmdData *)clientData; @@ -2522,7 +2521,7 @@ Tcl_FindNamespace( * 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 + int flags) /* Flags controlling namespace lookup: an OR'd * combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG flags. */ { @@ -3369,7 +3368,7 @@ NamespaceDeleteCmd( static int NamespaceEvalCmd( - void *clientData, /* Arbitrary value passed to cmd. */ + void *clientData, /* Arbitrary value passed to cmd. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3758,7 +3757,7 @@ NamespaceImportCmd( if (cmdPtr->deleteProc == DeleteImportedCmd) { Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj( - (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1)); + (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr), -1)); } } Tcl_SetObjResult(interp, listPtr); @@ -3818,7 +3817,7 @@ NamespaceImportCmd( static int NamespaceInscopeCmd( - void *clientData, /* Arbitrary value passed to cmd. */ + void *clientData, /* Arbitrary value passed to cmd. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -4691,7 +4690,7 @@ NamespaceWhichCmd( TclNewObj(resultPtr); switch (lookupType) { case 0: { /* -command */ - Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]); + Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc - 1]); if (cmd != NULL) { Tcl_GetCommandFullName(interp, cmd, resultPtr); @@ -4700,7 +4699,7 @@ NamespaceWhichCmd( } case 1: { /* -variable */ Tcl_Var var = Tcl_FindNamespaceVar(interp, - TclGetString(objv[objc-1]), NULL, /*flags*/ 0); + TclGetString(objv[objc - 1]), NULL, /*flags*/ 0); if (var != NULL) { Tcl_GetVariableFullName(interp, var, resultPtr); @@ -4733,7 +4732,7 @@ NamespaceWhichCmd( static void FreeNsNameInternalRep( - Tcl_Obj *objPtr) /* nsName object with internal representation + Tcl_Obj *objPtr) /* nsName object with internal representation * to free. */ { ResolvedNsName *resNamePtr; @@ -4780,7 +4779,7 @@ FreeNsNameInternalRep( static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedNsName *resNamePtr; @@ -4816,7 +4815,7 @@ 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. */ + Tcl_Obj *objPtr) /* The object to convert. */ { const char *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; @@ -4829,7 +4828,7 @@ SetNsNameFromAny( name = TclGetString(objPtr); TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS, - &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); + &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) { return TCL_ERROR; diff --git a/generic/tclNotify.c b/generic/tclNotify.c index ec24a4b..dd0a0be 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -71,7 +71,7 @@ typedef struct ThreadSpecificData { /* Pointer to first event source in list of * event sources for this thread. */ Tcl_ThreadId threadId; /* Thread that owns this notifier instance. */ - void *clientData; /* Opaque handle for platform specific + void *clientData; /* Opaque handle for platform specific * notifier. */ int initialized; /* 1 if notifier has been initialized. */ struct ThreadSpecificData *nextPtr; @@ -305,7 +305,7 @@ Tcl_CreateEventSource( Tcl_EventCheckProc *checkProc, /* Function to call after waiting to see what * happened. */ - void *clientData) /* One-word argument to pass to setupProc and + void *clientData) /* One-word argument to pass to setupProc and * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -344,7 +344,7 @@ Tcl_DeleteEventSource( Tcl_EventCheckProc *checkProc, /* Function to call after waiting to see what * happened. */ - void *clientData) /* One-word argument to pass to setupProc and + void *clientData) /* One-word argument to pass to setupProc and * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -556,7 +556,7 @@ QueueEvent( void Tcl_DeleteEvents( Tcl_EventDeleteProc *proc, /* The function to call. */ - void *clientData) /* The type-specific data. */ + void *clientData) /* The type-specific data. */ { Tcl_Event *evPtr; /* Pointer to the event being examined */ Tcl_Event *prevPtr; /* Pointer to evPtr's predecessor, or NULL if @@ -1253,7 +1253,7 @@ Tcl_FinalizeNotifier( void Tcl_AlertNotifier( - void *clientData) /* Pointer to thread data. */ + void *clientData) /* Pointer to thread data. */ { if (tclNotifierHooks.alertNotifierProc) { tclNotifierHooks.alertNotifierProc(clientData); @@ -1310,7 +1310,7 @@ Tcl_ServiceModeHook( void Tcl_SetTimer( - const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ + const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { if (tclNotifierHooks.setTimerProc) { tclNotifierHooks.setTimerProc(timePtr); @@ -1341,7 +1341,7 @@ Tcl_SetTimer( int Tcl_WaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { if (tclNotifierHooks.waitForEventProc) { return tclNotifierHooks.waitForEventProc(timePtr); @@ -1380,7 +1380,7 @@ Tcl_CreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { if (tclNotifierHooks.createFileHandlerProc) { tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData); diff --git a/generic/tclOO.c b/generic/tclOO.c index 6074147..9229c08 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -104,9 +104,9 @@ static void MyClassDeleted(void *clientData); * Note that the core methods don't need clone or free proc callbacks. */ -#define DCM(name,visibility,proc) \ - {name,visibility,\ - {TCL_OO_METHOD_VERSION_CURRENT,"core method: "#name,proc,NULL,NULL}} +#define DCM(name, visibility, proc) \ + {name, visibility, \ + {TCL_OO_METHOD_VERSION_CURRENT, "core method: "#name, proc, NULL, NULL}} static const DeclaredClassMethod objMethods[] = { DCM("destroy", 1, TclOO_Object_Destroy), @@ -180,9 +180,9 @@ MODULE_SCOPE const TclOOStubs tclOOStubs; #define IsRootClass(ocPtr) ((ocPtr)->flags & ROOT_CLASS) #define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS)) -#define RemoveItem(type, lst, i) \ +#define RemoveItem(type, lst, idx) \ do { \ - Remove ## type ((lst).list, (lst).num, i); \ + Remove ## type ((lst).list, (lst).num, idx); \ (lst).num--; \ } while (0) @@ -415,7 +415,7 @@ InitFoundation( NULL); Tcl_CreateObjCommand(interp, "::oo::objdefine", TclOOObjDefObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL,NULL); + Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL, NULL); TclOOInitInfo(interp); /* @@ -576,8 +576,8 @@ DeletedHelpersNamespace( static void KillFoundation( TCL_UNUSED(void *), - Tcl_Interp *interp) /* The interpreter containing the OO system - * foundation. */ + Tcl_Interp *interp) /* The interpreter containing the OO system + * foundation. */ { Foundation *fPtr = GetFoundation(interp); @@ -751,7 +751,7 @@ AllocObject( TclOOPrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted); oPtr->myclassCommand = TclNRCreateCommandInNs(interp, "myclass", oPtr->namespacePtr, TclOOMyClassObjCmd, MyClassNRObjCmd, oPtr, - MyClassDeleted); + MyClassDeleted); return oPtr; } @@ -791,7 +791,7 @@ SquelchCachedName( static void MyDeleted( - void *clientData) /* Reference to the object whose [my] has been + void *clientData) /* Reference to the object whose [my] has been * squelched. */ { Object *oPtr = (Object *)clientData; @@ -822,7 +822,7 @@ MyClassDeleted( static void ObjectRenamedTrace( - void *clientData, /* The object being deleted. */ + void *clientData, /* The object being deleted. */ TCL_UNUSED(Tcl_Interp *), TCL_UNUSED(const char *) /*oldName*/, TCL_UNUSED(const char *) /*newName*/, @@ -1135,7 +1135,7 @@ TclOOReleaseClassContents( static void ObjectNamespaceDeleted( - void *clientData) /* Pointer to the class whose namespace is + void *clientData) /* Pointer to the class whose namespace is * being deleted. */ { Object *oPtr = (Object *)clientData; @@ -1718,10 +1718,10 @@ Tcl_NewObjectInstance( const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - Tcl_Size objc, /* Number of arguments. Negative value means + Tcl_Size objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - Tcl_Size skip) /* Number of arguments to _not_ pass to the + Tcl_Size skip) /* Number of arguments to _not_ pass to the * constructor. */ { Class *classPtr = (Class *) cls; @@ -1786,10 +1786,10 @@ TclNRNewObjectInstance( const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - Tcl_Size objc, /* Number of arguments. Negative value means + Tcl_Size objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - Tcl_Size skip, /* Number of arguments to _not_ pass to the + Tcl_Size skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ @@ -2560,7 +2560,7 @@ TclOOPublicObjectCmd( int objc, Tcl_Obj *const *objv) { - return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv); + return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData, objc, objv); } static int @@ -2581,7 +2581,7 @@ TclOOPrivateObjectCmd( int objc, Tcl_Obj *const *objv) { - return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv); + return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd, clientData, objc, objv); } static int @@ -2607,7 +2607,7 @@ TclOOInvokeObject( * (PRIVATE_METHOD), or a *really* private * context (any other value; conventionally * 0). */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Array of argument objects. It is assumed * that the name of the method to invoke will * be at index 1. */ @@ -2678,7 +2678,7 @@ int TclOOObjectCmdCore( Object *oPtr, /* The object being invoked. */ Tcl_Interp *interp, /* The interpreter containing the object. */ - Tcl_Size objc, /* How many arguments are being passed in. */ + Tcl_Size objc, /* How many arguments are being passed in. */ Tcl_Obj *const *objv, /* The array of arguments. */ int flags, /* Whether this is an invocation through the * public or the private command interface. */ @@ -2813,7 +2813,7 @@ TclOOObjectCmdCore( * for the duration. */ - TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL); + TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL, NULL, NULL); return TclOOInvokeContext(contextPtr, interp, objc, objv); } diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 11af6a2..fd10339 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -896,7 +896,7 @@ TclOONextObjCmd( * that this is like [uplevel 1] and not [eval]. */ - TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL); + TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL, NULL, NULL); iPtr->varFramePtr = framePtr->callerVarPtr; return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1); } diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 46ee8be..6703a1f 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -25,7 +25,7 @@ struct ChainBuilder { CallChain *callChainPtr; /* The call chain being built. */ - size_t filterLength; /* Number of entries in the call chain that + size_t filterLength; /* Number of entries in the call chain that * are due to processing filters and not the * main call chain. */ Object *oPtr; /* The object that we are building the chain @@ -308,7 +308,7 @@ FreeMethodNameRep( int TclOOInvokeContext( - void *clientData, /* The method call context. */ + void *clientData, /* The method call context. */ Tcl_Interp *interp, /* Interpreter for error reporting, and many * other sorts of context handling (e.g., * commands, variables) depending on method @@ -357,9 +357,9 @@ TclOOInvokeContext( */ if (contextPtr->oPtr->flags & FILTER_HANDLING) { - TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL); + TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL, NULL, NULL); } else { - TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL); + TclNRAddCallback(interp, ResetFilterFlags, contextPtr, NULL, NULL, NULL); } if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) { contextPtr->oPtr->flags |= FILTER_HANDLING; @@ -677,7 +677,7 @@ CmpStr( static void AddClassMethodNames( Class *clsPtr, /* Class to get method names from. */ - int flags, /* Whether we are interested in just the + int flags, /* Whether we are interested in just the * public method names. */ Tcl_HashTable *const namesPtr, /* Reference to the hash table to put the @@ -2038,8 +2038,9 @@ AddSimpleClassDefineNamespaces( static inline void AddDefinitionNamespaceToChain( - Class *const definerCls, /* What class defines this entry. */ - Tcl_Obj *const namespaceName, /* The name for this entry (or NULL, a + Class *const definerCls, /* What class defines this entry. */ + Tcl_Obj *const namespaceName, + /* The name for this entry (or NULL, a * no-op). */ DefineChain *const definePtr, /* The define chain to add the method diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 7bee39b..e9efd6b 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -40,7 +40,7 @@ struct DeclaredSlot { const Tcl_MethodType resolverType; }; -#define SLOT(name,getter,setter,resolver) \ +#define SLOT(name, getter, setter, resolver) \ {"::oo::" name, \ {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \ getter, NULL, NULL}, \ @@ -2677,7 +2677,7 @@ ClassSuperSet( Tcl_SetObjResult(interp, Tcl_NewStringObj( "class should only be a direct superclass once", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",(char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", (char *)NULL); goto failedAfterAlloc; } } diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 031b910..6332539 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -46,8 +46,8 @@ typedef struct Method { /* The type of method. If NULL, this is a * special flag record which is just used for * the setting of the flags field. */ - Tcl_Size refCount; - void *clientData; /* Type-specific data. */ + Tcl_Size refCount; /* Reference counter for this structure. */ + void *clientData; /* Type-specific data. */ Tcl_Obj *namePtr; /* Name of the method. */ struct Object *declaringObjectPtr; /* The object that declares this method, or @@ -209,9 +209,9 @@ typedef struct Object { * references; this mechanism exists to * avoid Tcl_Preserve. */ int flags; - Tcl_Size creationEpoch; /* Unique value to make comparisons of objects + Tcl_Size creationEpoch; /* Unique value to make comparisons of objects * easier. */ - Tcl_Size epoch; /* Per-object epoch, incremented when the way + Tcl_Size epoch; /* Per-object epoch, incremented when the way * an object should resolve call chains is * changed. */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to @@ -519,16 +519,16 @@ MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr); MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp, Object *useThisObj); MODULE_SCOPE int TclMethodIsType(Tcl_Method method, - const Tcl_MethodType *typePtr, - void **clientDataPtr); + const Tcl_MethodType *typePtr, + void **clientDataPtr); MODULE_SCOPE Tcl_Method TclNewInstanceMethod(Tcl_Interp *interp, - Tcl_Object object, Tcl_Obj *nameObj, - int flags, const Tcl_MethodType *typePtr, - void *clientData); + Tcl_Object object, Tcl_Obj *nameObj, + int flags, const Tcl_MethodType *typePtr, + void *clientData); MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Interp *interp, Tcl_Class cls, - Tcl_Obj *nameObj, int flags, - const Tcl_MethodType *typePtr, - void *clientData); + Tcl_Obj *nameObj, int flags, + const Tcl_MethodType *typePtr, + void *clientData); MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, Tcl_Size objc, @@ -611,9 +611,9 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); * REQUIRES DECLARATION: Tcl_Size i; */ -#define FOREACH(var,ary) \ - for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \ - continue; \ +#define FOREACH(var, ary) \ + for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \ + continue; \ } else if ((var) = (ary).list[i], 1) /* @@ -623,7 +623,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); * REQUIRES DECLARATION: Tcl_Size i; See [96551aca55] for more FOREACH_STRUCT details. */ -#define FOREACH_STRUCT(var,ary) \ +#define FOREACH_STRUCT(var, ary) \ if (i=0, (ary).num>0) for(; var=&((ary).list[i]), i<(ary).num; i++) /* @@ -636,13 +636,15 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); #define FOREACH_HASH_DECLS \ Tcl_HashEntry *hPtr;Tcl_HashSearch search -#define FOREACH_HASH(key,val,tablePtr) \ - for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ - (*(void **)&(key)=Tcl_GetHashKey((tablePtr),hPtr),\ - *(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search)) -#define FOREACH_HASH_VALUE(val,tablePtr) \ - for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ - (*(void **)&(val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search)) +#define FOREACH_HASH(key, val, tablePtr) \ + for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ + (*(void **)&(key)=Tcl_GetHashKey((tablePtr),hPtr), \ + *(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; \ + hPtr=Tcl_NextHashEntry(&search)) +#define FOREACH_HASH_VALUE(val, tablePtr) \ + for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ + (*(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; \ + hPtr=Tcl_NextHashEntry(&search)) /* * Convenience macro for duplicating a list. Needs no external declaration, @@ -650,14 +652,15 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); */ #undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */ -#define DUPLICATE(target,source,type) \ - do { \ - size_t len = sizeof(type) * ((target).num=(source).num);\ - if (len != 0) { \ - memcpy(((target).list=(type*)Tcl_Alloc(len)), (source).list, len); \ - } else { \ - (target).list = NULL; \ - } \ +#define DUPLICATE(target, source, type) \ + do { \ + size_t len = sizeof(type) * ((target).num=(source).num); \ + if (len != 0) { \ + memcpy(((target).list=(type*) \ + Tcl_Alloc(len)), (source).list, len); \ + } else { \ + (target).list = NULL; \ + } \ } while(0) #endif /* TCL_OO_INTERNAL_H */ diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index be51f0b..8ccaeb5 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -268,7 +268,7 @@ TclNewMethod( mPtr->refCount = 1; goto populate; } - hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, nameObj,&isNew); + hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, nameObj, &isNew); if (isNew) { mPtr = (Method *)Tcl_Alloc(sizeof(Method)); mPtr->refCount = 1; @@ -536,7 +536,7 @@ TclOOMakeProcInstanceMethod( * NULL. */ const Tcl_MethodType *typePtr, /* The type of the method to create. */ - void *clientData, /* The per-method type-specific data. */ + void *clientData, /* The per-method type-specific data. */ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the @@ -649,7 +649,7 @@ TclOOMakeProcMethod( * NULL. */ const Tcl_MethodType *typePtr, /* The type of the method to create. */ - void *clientData, /* The per-method type-specific data. */ + void *clientData, /* The per-method type-specific data. */ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the @@ -744,7 +744,7 @@ TclOOMakeProcMethod( static int InvokeProcedureMethod( - void *clientData, /* Pointer to some per-method context. */ + void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ @@ -1259,7 +1259,7 @@ RenderDeclarerName( /* TODO: Check whether Tcl_AppendLimitedToObj() can work here. */ #define LIMIT 60 -#define ELLIPSIFY(str,len) \ +#define ELLIPSIFY(str, len) \ ((len) > LIMIT ? LIMIT : (int)(len)), (str), ((len) > LIMIT ? "..." : "") static void @@ -1544,7 +1544,7 @@ TclOONewForwardMethod( static int InvokeForwardMethod( - void *clientData, /* Pointer to some per-method context. */ + void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ diff --git a/generic/tclObj.c b/generic/tclObj.c index 36856d4..aa36da6 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -78,26 +78,26 @@ typedef struct { typedef struct { Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj - * generated by a call to the function - * TclSubstTokens() from a literal text - * where bs+nl sequences occurred in it, if - * any. I.e. this table keeps track of - * invisible and stripped continuation lines. - * Its keys are Tcl_Obj pointers, the values - * are ContLineLoc pointers. See the file - * tclCompile.h for the definition of this - * structure, and for references to all - * related places in the core. */ + * generated by a call to the function + * TclSubstTokens() from a literal text + * where bs+nl sequences occurred in it, if + * any. I.e. this table keeps track of + * invisible and stripped continuation lines. + * Its keys are Tcl_Obj pointers, the values + * are ContLineLoc pointers. See the file + * tclCompile.h for the definition of this + * structure, and for references to all + * related places in the core. */ #if TCL_THREADS && defined(TCL_MEM_DEBUG) Tcl_HashTable *objThreadMap;/* Thread local table that is used to check - * that a Tcl_Obj was not allocated by some - * other thread. */ + * that a Tcl_Obj was not allocated by some + * other thread. */ #endif /* TCL_MEM_DEBUG && TCL_THREADS */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -static void TclThreadFinalizeContLines(void *clientData); +static void TclThreadFinalizeContLines(void *clientData); static ThreadSpecificData *TclGetContLineTable(void); /* @@ -145,13 +145,13 @@ typedef struct PendingObjData { #define ObjDeletionUnlock(contextPtr) ((contextPtr)->deletionCount--) #define ObjDeletePending(contextPtr) ((contextPtr)->deletionCount > 0) #define ObjOnStack(contextPtr) ((contextPtr)->deletionStack != NULL) -#define PushObjToDelete(contextPtr,objPtr) \ +#define PushObjToDelete(contextPtr, objPtr) \ /* The string rep is already invalidated so we can use the bytes value \ - * for our pointer chain: push onto the head of the stack. */ \ - (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \ + * for our pointer chain: push onto the head of the stack. */ \ + (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \ (contextPtr)->deletionStack = (objPtr) -#define PopObjToDelete(contextPtr,objPtrVar) \ - (objPtrVar) = (contextPtr)->deletionStack; \ +#define PopObjToDelete(contextPtr, objPtrVar) \ + (objPtrVar) = (contextPtr)->deletionStack; \ (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes /* @@ -168,8 +168,8 @@ static __thread PendingObjData pendingObjData; #else static Tcl_ThreadDataKey pendingObjDataKey; #define ObjInitDeletionContext(contextPtr) \ - PendingObjData *const contextPtr = \ - (PendingObjData *)Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData)) + PendingObjData *const contextPtr = (PendingObjData *) \ + Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData)) #endif /* @@ -177,15 +177,16 @@ static Tcl_ThreadDataKey pendingObjDataKey; */ #define PACK_BIGNUM(bignum, objPtr) \ - if ((bignum).used > 0x7FFF) { \ - mp_int *temp = (mp_int *)Tcl_Alloc(sizeof(mp_int)); \ - *temp = bignum; \ - (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ - (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ - } else if (((bignum).alloc <= 0x7FFF) || (mp_shrink(&(bignum))) == MP_OKAY) { \ - (objPtr)->internalRep.twoPtrValue.ptr1 = (bignum).dp; \ + if ((bignum).used > 0x7FFF) { \ + mp_int *temp = (mp_int *)Tcl_Alloc(sizeof(mp_int)); \ + *temp = bignum; \ + (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ + (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ + } else if (((bignum).alloc <= 0x7FFF) \ + || (mp_shrink(&(bignum))) == MP_OKAY) { \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (bignum).dp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \ - | ((bignum).alloc << 15) | ((bignum).used)); \ + | ((bignum).alloc << 15) | ((bignum).used)); \ } /* @@ -515,7 +516,7 @@ TclGetContLineTable(void) if (!tsdPtr->lineCLPtr) { tsdPtr->lineCLPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS); - Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL); + Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines, NULL); } return tsdPtr; } @@ -577,7 +578,7 @@ TclContinuationsEnter( clLocPtr->num = num; memcpy(&clLocPtr->loc, loc, num*sizeof(Tcl_Size)); - clLocPtr->loc[num] = CLL_END; /* Sentinel */ + clLocPtr->loc[num] = CLL_END; /* Sentinel */ Tcl_SetHashValue(hPtr, clLocPtr); return clLocPtr; @@ -637,7 +638,7 @@ TclContinuationsEnterDerived( */ (void)TclGetStringFromObj(objPtr, &length); - end = start + length; /* First char after the word */ + end = start + length; /* First char after the word */ /* * Then compute the table slice covering the range of the word. @@ -702,8 +703,7 @@ TclContinuationsCopy( Tcl_Obj *originObjPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); - Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr); if (hPtr) { ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_GetHashValue(hPtr); @@ -736,11 +736,10 @@ TclContinuationsGet( Tcl_Obj *objPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); - Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (!hPtr) { - return NULL; + return NULL; } return (ContLineLoc *)Tcl_GetHashValue(hPtr); } @@ -1034,9 +1033,9 @@ TclDbDumpActiveObjects( void TclDbInitNewObj( Tcl_Obj *objPtr, - const char *file, /* The name of the source file calling this + 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 + int line) /* Line number in the source file; used for * debugging. */ { objPtr->refCount = 0; @@ -1162,9 +1161,9 @@ Tcl_NewObj(void) Tcl_Obj * Tcl_DbNewObj( - const char *file, /* The name of the source file calling this + 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 + int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; @@ -1269,7 +1268,7 @@ TclAllocateFreeObjects(void) #ifdef TCL_MEM_DEBUG void TclFreeObj( - Tcl_Obj *objPtr) /* The object to be freed. */ + Tcl_Obj *objPtr) /* The object to be freed. */ { const Tcl_ObjType *typePtr = objPtr->typePtr; @@ -1379,10 +1378,10 @@ TclFreeObj( { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { - hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); + hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); @@ -1394,7 +1393,7 @@ TclFreeObj( void TclFreeObj( - Tcl_Obj *objPtr) /* The object to be freed. */ + Tcl_Obj *objPtr) /* The object to be freed. */ { /* * Invalidate the string rep first so we can use the bytes value for our @@ -1470,10 +1469,10 @@ TclFreeObj( { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { - hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); + hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); @@ -1537,7 +1536,7 @@ TclObjBeingDeleted( *---------------------------------------------------------------------- */ -#define SetDuplicateObj(dupPtr, objPtr) \ +#define SetDuplicateObj(dupPtr, objPtr) \ { \ const Tcl_ObjType *typePtr = (objPtr)->typePtr; \ const char *bytes = (objPtr)->bytes; \ @@ -1604,7 +1603,7 @@ TclSetDuplicateObj( #undef Tcl_GetString char * Tcl_GetString( - Tcl_Obj *objPtr) /* Object whose string rep byte pointer should + Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be returned. */ { if (objPtr->bytes == NULL) { @@ -1662,9 +1661,9 @@ Tcl_GetString( #undef TclGetStringFromObj char * TclGetStringFromObj( - Tcl_Obj *objPtr, /* Object whose string rep byte pointer should + Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ - void *lengthPtr) /* If non-NULL, the location where the string + void *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { @@ -1707,7 +1706,7 @@ TclGetStringFromObj( #undef Tcl_GetStringFromObj char * Tcl_GetStringFromObj( - Tcl_Obj *objPtr, /* Object whose string rep byte pointer should + Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ Tcl_Size *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. @@ -1790,7 +1789,7 @@ Tcl_GetStringFromObj( char * Tcl_InitStringRep( - Tcl_Obj *objPtr, /* Object whose string rep is to be set */ + Tcl_Obj *objPtr, /* Object whose string rep is to be set */ const char *bytes, size_t numBytes) { @@ -1861,7 +1860,7 @@ Tcl_InitStringRep( void Tcl_InvalidateStringRep( - Tcl_Obj *objPtr) /* Object whose string rep byte pointer should + Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be freed. */ { TclInvalidateStringRep(objPtr); @@ -1881,7 +1880,7 @@ Tcl_InvalidateStringRep( int Tcl_HasStringRep( - Tcl_Obj *objPtr) /* Object to test */ + Tcl_Obj *objPtr) /* Object to test */ { return TclHasStringRep(objPtr); } @@ -1912,7 +1911,8 @@ void Tcl_StoreInternalRep( Tcl_Obj *objPtr, /* Object whose internal rep should be set. */ const Tcl_ObjType *typePtr, /* New type for the object */ - const Tcl_ObjInternalRep *irPtr) /* New internalrep for the object */ + const Tcl_ObjInternalRep *irPtr) + /* New internalrep for the object */ { /* Clear out any existing internalrep ( "shimmer" ) */ TclFreeInternalRep(objPtr); @@ -1973,7 +1973,7 @@ Tcl_FetchInternalRep( void Tcl_FreeInternalRep( - Tcl_Obj *objPtr) /* Object whose internal rep should be freed. */ + Tcl_Obj *objPtr) /* Object whose internal rep should be freed. */ { TclFreeInternalRep(objPtr); } @@ -2000,27 +2000,32 @@ Tcl_FreeInternalRep( #undef Tcl_GetBoolFromObj int Tcl_GetBoolFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get boolean. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get boolean. */ int flags, - char *charPtr) /* Place to store resulting boolean. */ + char *charPtr) /* Place to store resulting boolean. */ { int result; - if ((flags & TCL_NULL_OK) && (objPtr == NULL || Tcl_GetString(objPtr)[0] == '\0')) { + if ((flags & TCL_NULL_OK) + && (objPtr == NULL || Tcl_GetString(objPtr)[0] == '\0')) { result = -1; goto boolEnd; } else if (objPtr == NULL) { if (interp) { TclNewObj(objPtr); - TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK) - ? "boolean value or \"\"" : "boolean value", NULL, TCL_INDEX_NONE, NULL, 0); + TclParseNumber(interp, objPtr, + (flags & TCL_NULL_OK) + ? "boolean value or \"\"" + : "boolean value", + NULL, TCL_INDEX_NONE, NULL, 0); Tcl_DecrRefCount(objPtr); } return TCL_ERROR; } do { - if (TclHasInternalRep(objPtr, &tclIntType) || TclHasInternalRep(objPtr, &tclBooleanType)) { + if (TclHasInternalRep(objPtr, &tclIntType) + || TclHasInternalRep(objPtr, &tclBooleanType)) { result = (objPtr->internalRep.wideValue != 0); goto boolEnd; } @@ -2062,19 +2067,23 @@ Tcl_GetBoolFromObj( return TCL_OK; } } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK == - TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK) - ? "boolean value or \"\"" : "boolean value", NULL,-1,NULL,0))); + TclParseNumber(interp, objPtr, + (flags & TCL_NULL_OK) + ? "boolean value or \"\"" + : "boolean value", + NULL, -1, NULL, 0))); return TCL_ERROR; } #undef Tcl_GetBooleanFromObj int Tcl_GetBooleanFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get boolean. */ - int *intPtr) /* Place to store resulting boolean. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get boolean. */ + int *intPtr) /* Place to store resulting boolean. */ { - return Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof(int), (char *)(void *)intPtr); + return Tcl_GetBoolFromObj(interp, objPtr, + (TCL_NULL_OK - 2) & (int) sizeof(int), (char *)(void *)intPtr); } /* @@ -2100,7 +2109,7 @@ Tcl_GetBooleanFromObj( int TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { /* * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine @@ -2146,7 +2155,7 @@ TclSetBooleanFromAny( static int ParseBoolean( - Tcl_Obj *objPtr) /* The object to parse/convert. */ + Tcl_Obj *objPtr) /* The object to parse/convert. */ { int newBool; char lowerCase[6]; @@ -2288,7 +2297,7 @@ ParseBoolean( Tcl_Obj * Tcl_NewDoubleObj( - double dblValue) /* Double used to initialize the object. */ + double dblValue) /* Double used to initialize the object. */ { return Tcl_DbNewDoubleObj(dblValue, "unknown", 0); } @@ -2297,7 +2306,7 @@ Tcl_NewDoubleObj( Tcl_Obj * Tcl_NewDoubleObj( - double dblValue) /* Double used to initialize the object. */ + double dblValue) /* Double used to initialize the object. */ { Tcl_Obj *objPtr; @@ -2336,7 +2345,7 @@ Tcl_NewDoubleObj( Tcl_Obj * Tcl_DbNewDoubleObj( - double dblValue, /* Double used to initialize the object. */ + 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 @@ -2357,7 +2366,7 @@ Tcl_DbNewDoubleObj( Tcl_Obj * Tcl_DbNewDoubleObj( - double dblValue, /* Double used to initialize the object. */ + double dblValue, /* Double used to initialize the object. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { @@ -2385,8 +2394,8 @@ Tcl_DbNewDoubleObj( void Tcl_SetDoubleObj( - Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - double dblValue) /* Double used to set the object's value. */ + 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"); @@ -2417,9 +2426,9 @@ Tcl_SetDoubleObj( 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. */ + 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 (TclHasInternalRep(objPtr, &tclDoubleType)) { @@ -2427,8 +2436,8 @@ Tcl_GetDoubleFromObj( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "floating point value is Not a Number", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN", - (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN", + (void *)NULL); } return TCL_ERROR; } @@ -2473,7 +2482,7 @@ Tcl_GetDoubleFromObj( static int SetDoubleFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1, NULL, 0); @@ -2501,7 +2510,7 @@ SetDoubleFromAny( static void UpdateStringOfDouble( - Tcl_Obj *objPtr) /* Double obj with string rep to update. */ + Tcl_Obj *objPtr) /* Double obj with string rep to update. */ { char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE); @@ -2542,9 +2551,9 @@ UpdateStringOfDouble( 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. */ + 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); @@ -2614,7 +2623,7 @@ SetIntFromAny( static void UpdateStringOfInt( - Tcl_Obj *objPtr) /* Int object whose string rep to update. */ + Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); @@ -2646,9 +2655,9 @@ UpdateStringOfInt( 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. */ + 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 @@ -2678,9 +2687,9 @@ Tcl_GetLongFromObj( #endif if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; @@ -2764,8 +2773,7 @@ Tcl_GetLongFromObj( Tcl_Obj * Tcl_NewWideIntObj( - Tcl_WideInt wideValue) - /* Wide integer used to initialize the new + Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { return Tcl_DbNewWideIntObj(wideValue, "unknown", 0); @@ -2775,8 +2783,7 @@ Tcl_NewWideIntObj( Tcl_Obj * Tcl_NewWideIntObj( - Tcl_WideInt wideValue) - /* Wide integer used to initialize the new + Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { Tcl_Obj *objPtr; @@ -2804,8 +2811,7 @@ Tcl_NewWideIntObj( Tcl_Obj * Tcl_NewWideUIntObj( - Tcl_WideUInt uwideValue) - /* Wide integer used to initialize the new + Tcl_WideUInt uwideValue) /* Wide integer used to initialize the new * object. */ { Tcl_Obj *objPtr; @@ -2850,8 +2856,7 @@ Tcl_NewWideUIntObj( Tcl_Obj * Tcl_DbNewWideIntObj( - Tcl_WideInt wideValue, - /* Wide integer used to initialize the new + 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. */ @@ -2869,8 +2874,7 @@ Tcl_DbNewWideIntObj( Tcl_Obj * Tcl_DbNewWideIntObj( - Tcl_WideInt wideValue, - /* Long integer used to initialize the new + Tcl_WideInt wideValue, /* Long integer used to initialize the new * object. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) @@ -2899,9 +2903,8 @@ Tcl_DbNewWideIntObj( void Tcl_SetWideIntObj( - Tcl_Obj *objPtr, /* Object w. internal rep to init. */ - Tcl_WideInt wideValue) - /* Wide integer used to initialize the + 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)) { @@ -2931,9 +2934,8 @@ Tcl_SetWideIntObj( void Tcl_SetWideUIntObj( - Tcl_Obj *objPtr, /* Object w. internal rep to init. */ - Tcl_WideUInt uwideValue) - /* Wide integer used to initialize the + Tcl_Obj *objPtr, /* Object w. internal rep to init. */ + Tcl_WideUInt uwideValue) /* Wide integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { @@ -2974,10 +2976,9 @@ Tcl_SetWideUIntObj( 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. */ + 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 (TclHasInternalRep(objPtr, &tclIntType)) { @@ -2986,9 +2987,9 @@ Tcl_GetWideIntFromObj( } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; @@ -3006,7 +3007,8 @@ Tcl_GetWideIntFromObj( unsigned char *bytes = (unsigned char *) &scratch; TclUnpackBignum(objPtr, big); - if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes) == MP_OKAY) { + if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), + &numBytes) == MP_OKAY) { while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } @@ -3059,10 +3061,9 @@ Tcl_GetWideIntFromObj( int Tcl_GetWideUIntFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* Object from which to get a wide int. */ - Tcl_WideUInt *wideUIntPtr) - /* Place to store resulting long. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* Object from which to get a wide int. */ + Tcl_WideUInt *wideUIntPtr) /* Place to store resulting long. */ { do { if (TclHasInternalRep(objPtr, &tclIntType)) { @@ -3098,7 +3099,8 @@ Tcl_GetWideUIntFromObj( if (big.sign == MP_NEG) { goto wideUIntOutOfRange; } - if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideUInt), &numBytes) == MP_OKAY) { + if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideUInt), + &numBytes) == MP_OKAY) { while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } @@ -3144,9 +3146,9 @@ Tcl_GetWideUIntFromObj( int TclGetWideBitsFromObj( - 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 wide integer. */ + 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 wide integer. */ { do { if (TclHasInternalRep(objPtr, &tclIntType)) { @@ -3155,9 +3157,9 @@ TclGetWideBitsFromObj( } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; @@ -3208,9 +3210,9 @@ TclGetWideBitsFromObj( */ int Tcl_GetSizeIntFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get a int. */ - Tcl_Size *sizePtr) /* Place to store resulting int. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get a int. */ + Tcl_Size *sizePtr) /* Place to store resulting int. */ { if (sizeof(Tcl_Size) == sizeof(int)) { return TclGetIntFromObj(interp, objPtr, (int *)sizePtr); @@ -3479,9 +3481,9 @@ GetBignumFromObj( } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; @@ -3520,7 +3522,7 @@ int Tcl_GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ - void *bignumValue) /* Returned bignum value. */ + void *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 1, (mp_int *)bignumValue); } @@ -3555,7 +3557,7 @@ int Tcl_TakeBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ - void *bignumValue) /* Returned bignum value. */ + void *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 0, (mp_int *)bignumValue); } @@ -3657,17 +3659,17 @@ TclSetBignumInternalRep( * * Tcl_GetNumberFromObj -- * - * Extracts a number (of any possible numeric type) from an object. + * Extracts a number (of any possible numeric type) from an object. * * Results: - * Whether the extraction worked. The type is stored in the variable - * referred to by the typePtr argument, and a pointer to the - * representation is stored in the variable referred to by the - * clientDataPtr. + * Whether the extraction worked. The type is stored in the variable + * referred to by the typePtr argument, and a pointer to the + * representation is stored in the variable referred to by the + * clientDataPtr. * * Side effects: - * Can allocate thread-specific data for handling the copy-out space for - * bignums; this space is shared within a thread. + * Can allocate thread-specific data for handling the copy-out space for + * bignums; this space is shared within a thread. * *---------------------------------------------------------------------- */ @@ -3761,7 +3763,8 @@ Tcl_GetNumber( #undef Tcl_IncrRefCount void Tcl_IncrRefCount( - Tcl_Obj *objPtr) /* The object we are registering a reference to. */ + Tcl_Obj *objPtr) /* The object we are registering a reference + * to. */ { ++(objPtr)->refCount; } @@ -3782,7 +3785,8 @@ Tcl_IncrRefCount( #undef Tcl_DecrRefCount void Tcl_DecrRefCount( - Tcl_Obj *objPtr) /* The object we are releasing a reference to. */ + Tcl_Obj *objPtr) /* The object we are releasing a reference + * to. */ { if (objPtr->refCount-- <= 1) { TclFreeObj(objPtr); @@ -3804,7 +3808,8 @@ Tcl_DecrRefCount( */ void TclUndoRefCount( - Tcl_Obj *objPtr) /* The object we are releasing a reference to. */ + Tcl_Obj *objPtr) /* The object we are releasing a reference + * to. */ { if (objPtr->refCount > 0) { --objPtr->refCount; @@ -3827,7 +3832,7 @@ TclUndoRefCount( #undef Tcl_IsShared int Tcl_IsShared( - Tcl_Obj *objPtr) /* The object to test for being shared. */ + Tcl_Obj *objPtr) /* The object to test for being shared. */ { return ((objPtr)->refCount > 1); } @@ -3856,7 +3861,7 @@ Tcl_IsShared( #ifdef TCL_MEM_DEBUG void Tcl_DbIncrRefCount( - Tcl_Obj *objPtr, /* The object we are registering a reference + 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. */ @@ -3887,7 +3892,7 @@ Tcl_DbIncrRefCount( hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", - "incr ref count"); + "incr ref count"); } } # endif /* TCL_THREADS */ @@ -3896,7 +3901,7 @@ Tcl_DbIncrRefCount( #else /* !TCL_MEM_DEBUG */ void Tcl_DbIncrRefCount( - Tcl_Obj *objPtr, /* The object we are registering a reference + Tcl_Obj *objPtr, /* The object we are registering a reference * to. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) @@ -3929,7 +3934,7 @@ Tcl_DbIncrRefCount( #ifdef TCL_MEM_DEBUG void Tcl_DbDecrRefCount( - Tcl_Obj *objPtr, /* The object we are releasing a reference + 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. */ @@ -3960,7 +3965,7 @@ Tcl_DbDecrRefCount( hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", - "decr ref count"); + "decr ref count"); } } # endif /* TCL_THREADS */ @@ -3972,7 +3977,7 @@ Tcl_DbDecrRefCount( #else /* !TCL_MEM_DEBUG */ void Tcl_DbDecrRefCount( - Tcl_Obj *objPtr, /* The object we are releasing a reference + Tcl_Obj *objPtr, /* The object we are releasing a reference * to. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) @@ -4006,7 +4011,7 @@ Tcl_DbDecrRefCount( int Tcl_DbIsShared( - Tcl_Obj *objPtr, /* The object to test for being shared. */ + Tcl_Obj *objPtr, /* The object to test for being shared. */ #ifdef TCL_MEM_DEBUG const char *file, /* The name of the source file calling this * function; used for debugging. */ @@ -4042,7 +4047,7 @@ Tcl_DbIsShared( hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", - "check shared status"); + "check shared status"); } } # endif /* TCL_THREADS */ @@ -4083,8 +4088,7 @@ Tcl_DbIsShared( void Tcl_InitObjHashTable( - Tcl_HashTable *tablePtr) - /* Pointer to table record, which is supplied + Tcl_HashTable *tablePtr) /* Pointer to table record, which is supplied * by the caller. */ { Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS, @@ -4306,7 +4310,7 @@ 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. + 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 @@ -4335,21 +4339,21 @@ Tcl_GetCommandFromObj( resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if (TclHasInternalRep(objPtr, &tclCmdNameType)) { - Command *cmdPtr = resPtr->cmdPtr; + Command *cmdPtr = resPtr->cmdPtr; - if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) - && (interp == cmdPtr->nsPtr->interp) - && !(cmdPtr->nsPtr->flags & NS_DYING)) { - Namespace *refNsPtr = (Namespace *) - TclGetCurrentNamespace(interp); + if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) + && (interp == cmdPtr->nsPtr->interp) + && !(cmdPtr->nsPtr->flags & NS_DYING)) { + Namespace *refNsPtr = (Namespace *) + TclGetCurrentNamespace(interp); - if ((resPtr->refNsPtr == NULL) + if ((resPtr->refNsPtr == NULL) || ((refNsPtr == resPtr->refNsPtr) - && (resPtr->refNsId == refNsPtr->nsId) - && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) { - return (Tcl_Command) cmdPtr; - } - } + && (resPtr->refNsId == refNsPtr->nsId) + && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) { + return (Tcl_Command) cmdPtr; + } + } } /* @@ -4359,7 +4363,7 @@ Tcl_GetCommandFromObj( /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */ if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) { - return NULL; + return NULL; } resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL); @@ -4442,7 +4446,7 @@ 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 + 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. */ @@ -4482,7 +4486,7 @@ TclSetCmdNameObj( static void FreeCmdNameInternalRep( - Tcl_Obj *objPtr) /* CmdName object with internal + Tcl_Obj *objPtr) /* CmdName object with internal * representation to free. */ { ResolvedCmdName *resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; @@ -4530,7 +4534,7 @@ FreeCmdNameInternalRep( static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1; @@ -4564,7 +4568,7 @@ DupCmdNameInternalRep( static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { const char *name; Command *cmdPtr; @@ -4651,7 +4655,8 @@ Tcl_RepresentationCmd( * "1872361827361287" */ - descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_SIZE_MODIFIER "d," + descObj = Tcl_ObjPrintf( + "value is a %s with a refcount of %" TCL_SIZE_MODIFIER "d," " object pointer at %p", objv[1]->typePtr ? objv[1]->typePtr->name : "pure string", objv[1]->refCount, objv[1]); @@ -4668,9 +4673,9 @@ Tcl_RepresentationCmd( } if (objv[1]->bytes) { - Tcl_AppendToObj(descObj, ", string representation \"", -1); + Tcl_AppendToObj(descObj, ", string representation \"", -1); Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length, - 16, "..."); + 16, "..."); Tcl_AppendToObj(descObj, "\"", -1); } else { Tcl_AppendToObj(descObj, ", no string representation", -1); diff --git a/generic/tclParse.c b/generic/tclParse.c index e88de0b..9c17e0c 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -205,8 +205,7 @@ Tcl_ParseCommand( * 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 + Tcl_Parse *parsePtr) /* Structure to fill in with information about * the parsed command; any previous * information in the structure is ignored. */ { @@ -531,7 +530,7 @@ Tcl_ParseCommand( /* Parse the whitespace between words. */ - scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type); + scanned = ParseWhiteSpace(src, numBytes, &parsePtr->incomplete, &type); src += scanned; numBytes -= scanned; } @@ -1039,7 +1038,7 @@ ParseComment( static int ParseTokens( - const char *src, /* First character to parse. */ + const char *src, /* First character to parse. */ Tcl_Size numBytes, /* Max number of bytes to scan. */ int mask, /* Specifies when to stop parsing. The parse * stops at the first unquoted character whose @@ -1390,15 +1389,20 @@ Tcl_ParseVarName( tokenPtr->numComponents = 0; ch = *src; - while (numBytes && (braceCount>0 || ch != '}')) { + while (numBytes && (braceCount > 0 || ch != '}')) { switch (ch) { - case '{': braceCount++; break; - case '}': braceCount--; break; + case '{': + braceCount++; + break; + case '}': + braceCount--; + break; case '\\': /* if 2 or more left, consume 2, else consume * just the \ and let it run into the end */ if (numBytes > 1) { - src++; numBytes--; + src++; + numBytes--; } } numBytes--; @@ -1411,7 +1415,7 @@ Tcl_ParseVarName( "missing close-brace for variable name", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; - parsePtr->term = tokenPtr->start-1; + parsePtr->term = tokenPtr->start - 1; parsePtr->incomplete = 1; goto error; } @@ -1531,7 +1535,7 @@ Tcl_ParseVarName( const char * Tcl_ParseVar( Tcl_Interp *interp, /* Context for looking up variable. */ - const char *start, /* Start of variable substitution. First + 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 @@ -1619,8 +1623,7 @@ Tcl_ParseBraces( Tcl_Size numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ - Tcl_Parse *parsePtr, - /* Structure to fill in with information about + 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 @@ -1820,8 +1823,7 @@ Tcl_ParseQuotedString( Tcl_Size numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ - Tcl_Parse *parsePtr, - /* Structure to fill in with information about + 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 diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 9a44863..1fac268 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -40,11 +40,11 @@ static int MakeTildeRelativePath(Tcl_Interp *interp, */ static const Tcl_ObjType fsPathType = { - "path", /* name */ - FreeFsPathInternalRep, /* freeIntRepProc */ - DupFsPathInternalRep, /* dupIntRepProc */ - UpdateStringOfFsPath, /* updateStringProc */ - SetFsPathFromAny, /* setFromAnyProc */ + "path", /* name */ + FreeFsPathInternalRep, /* freeIntRepProc */ + DupFsPathInternalRep, /* dupIntRepProc */ + UpdateStringOfFsPath, /* updateStringProc */ + SetFsPathFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; @@ -90,7 +90,7 @@ typedef struct { */ #define PATHOBJ(pathPtr) ((FsPath *) (TclFetchInternalRep((pathPtr), &fsPathType)->twoPtrValue.ptr1)) -#define SETPATHOBJ(pathPtr,fsPathPtr) \ +#define SETPATHOBJ(pathPtr, fsPathPtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \ @@ -155,17 +155,17 @@ TclFSNormalizeAbsolutePath( */ dirSep += zipVolumeLen-1; /* Start parse after : */ } else if (tclPlatform == TCL_PLATFORM_WINDOWS) { - if ( (dirSep[0] == '/' || dirSep[0] == '\\') - && (dirSep[1] == '/' || dirSep[1] == '\\') - && (dirSep[2] == '?') - && (dirSep[3] == '/' || dirSep[3] == '\\')) { + if ((dirSep[0] == '/' || dirSep[0] == '\\') + && (dirSep[1] == '/' || dirSep[1] == '\\') + && (dirSep[2] == '?') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { /* NT extended path */ dirSep += 4; - if ( (dirSep[0] == 'U' || dirSep[0] == 'u') - && (dirSep[1] == 'N' || dirSep[1] == 'n') - && (dirSep[2] == 'C' || dirSep[2] == 'c') - && (dirSep[3] == '/' || dirSep[3] == '\\')) { + if ((dirSep[0] == 'U' || dirSep[0] == 'u') + && (dirSep[1] == 'N' || dirSep[1] == 'n') + && (dirSep[2] == 'C' || dirSep[2] == 'c') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { /* NT extended UNC path */ dirSep += 4; } @@ -726,7 +726,7 @@ TclPathPart( splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); Tcl_IncrRefCount(splitPtr); - if (portion == TCL_PATH_TAIL) { + if (portion == TCL_PATH_TAIL) { /* * Return the last component, unless it is the only component, and * it is the root of an absolute path. @@ -1054,8 +1054,8 @@ TclJoinPath( } ptr = TclGetStringFromObj(res, &length); - /* - * A NULL value for fsPtr at this stage basically means we're trying + /* + * A NULL value for fsPtr at this stage basically means we're trying * to join a relative path onto something which is also relative (or * empty). There's nothing particularly wrong with that. */ @@ -2347,7 +2347,7 @@ DupFsPathInternalRep( static void UpdateStringOfFsPath( - Tcl_Obj *pathPtr) /* path obj with string rep to update. */ + Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); Tcl_Size cwdLen; @@ -2451,8 +2451,8 @@ TclNativePathInFilesystem( * * MakeTildeRelativePath -- * - * Returns a path relative to the home directory of a user. - * Note there is a difference between not specifying a user and + * Returns a path relative to the home directory of a user. + * Note there is a difference between not specifying a user and * explicitly specifying the current user. This mimics Tcl8's tilde * expansion. * @@ -2469,11 +2469,11 @@ TclNativePathInFilesystem( */ int MakeTildeRelativePath( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ - const char *user, /* User name. NULL -> current user */ - const char *subPath, /* Rest of path. May be NULL */ - Tcl_DString *dsPtr) /* Output. Is initialized by the function. Must be - * freed on success */ + Tcl_Interp *interp, /* May be NULL. Only used for error messages */ + const char *user, /* User name. NULL -> current user */ + const char *subPath, /* Rest of path. May be NULL */ + Tcl_DString *dsPtr) /* Output. Is initialized by the function. Must + * be freed on success */ { const char *dir; Tcl_DString dirString; @@ -2482,30 +2482,30 @@ MakeTildeRelativePath( Tcl_DStringInit(&dirString); if (user == NULL || user[0] == 0) { - /* No user name specified -> current user */ + /* No user name specified -> current user */ dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment variable to expand path", + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find HOME environment variable to expand path", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", - "HOMELESS", (void *)NULL); - } - return TCL_ERROR; - } + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", + "HOMELESS", (void *)NULL); + } + return TCL_ERROR; + } } else { - /* User name specified - ~user */ + /* User name specified - ~user */ dir = TclpGetUserHome(user, &dirString); if (dir == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", user)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", - (void *)NULL); - } - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "user \"%s\" doesn't exist", user)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", + (void *)NULL); + } + return TCL_ERROR; } } if (subPath) { @@ -2530,15 +2530,15 @@ MakeTildeRelativePath( * Wrapper around MakeTildeRelativePath. See that function. * * Results: - * Returns a Tcl_Obj containing the home directory of a user + * Returns a Tcl_Obj containing the home directory of a user * or NULL on failure with error message in interp if non-NULL. * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetHomeDirObj( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ - const char *user) /* User name. NULL -> current user */ + Tcl_Interp *interp, /* May be NULL. Only used for error messages */ + const char *user) /* User name. NULL -> current user */ { Tcl_DString dirString; @@ -2559,17 +2559,17 @@ TclGetHomeDirObj( * begin with a tilde, returns as is. * * Results: - * Returns a Tcl_Obj with resolved path. This may be a new Tcl_Obj + * Returns a Tcl_Obj with resolved path. This may be a new Tcl_Obj * with ref count 0 or that pathObj that was passed in without its * ref count modified. - * Returns NULL if the path begins with a ~ that cannot be resolved + * Returns NULL if the path begins with a ~ that cannot be resolved * and stores an error message in interp if non-NULL. * *---------------------------------------------------------------------- */ Tcl_Obj * TclResolveTildePath( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ + Tcl_Interp *interp, /* May be NULL. Only used for error messages */ Tcl_Obj *pathObj) { const char *path; @@ -2591,19 +2591,19 @@ TclResolveTildePath( split = FindSplitPos(path, '/'); if (split == 1) { - /* No user name specified -> current user */ + /* No user name specified -> current user */ if (MakeTildeRelativePath(interp, NULL, path[1] ? 2 + path : NULL, &resolvedPath) != TCL_OK) { return NULL; } } else { - /* User name specified - ~user */ - const char *expandedUser; - Tcl_DString userName; + /* User name specified - ~user */ + const char *expandedUser; + Tcl_DString userName; - Tcl_DStringInit(&userName); - Tcl_DStringAppend(&userName, path+1, split-1); - expandedUser = Tcl_DStringValue(&userName); + Tcl_DStringInit(&userName); + Tcl_DStringAppend(&userName, path+1, split-1); + expandedUser = Tcl_DStringValue(&userName); /* path[split] is / or \0 */ if (MakeTildeRelativePath(interp, expandedUser, @@ -2626,9 +2626,9 @@ TclResolveTildePath( * the paths with any ~-prefixed paths resolved. * * Empty strings and ~-prefixed paths that cannot be resolved are - * removed from the returned list. + * removed from the returned list. * - * The trailing components of the path are returned verbatim. No + * The trailing components of the path are returned verbatim. No * processing is done on them. Moreover, no assumptions should be * made about the separators in the returned path. They may be / * or native. Appropriate path manipulations functions should be @@ -2653,31 +2653,31 @@ TclResolveTildePathList( const char *path; if (pathsObj == NULL) { - return NULL; + return NULL; } if (Tcl_ListObjGetElements(NULL, pathsObj, &objc, &objv) != TCL_OK) { - return NULL; /* Not a list */ + return NULL; /* Not a list */ } /* * Figure out if any paths need resolving to avoid unnecessary allocations. */ for (i = 0; i < objc; ++i) { - path = Tcl_GetString(objv[i]); - if (path[0] == '~') { - break; /* At least one path needs resolution */ - } + path = Tcl_GetString(objv[i]); + if (path[0] == '~') { + break; /* At least one path needs resolution */ + } } if (i == objc) { - return pathsObj; /* No paths needed to be resolved */ + return pathsObj; /* No paths needed to be resolved */ } resolvedPaths = Tcl_NewListObj(objc, NULL); for (i = 0; i < objc; ++i) { Tcl_Obj *resolvedPath; - path = Tcl_GetString(objv[i]); + path = Tcl_GetString(objv[i]); if (path[0] == 0) { - continue; /* Skip empty strings */ + continue; /* Skip empty strings */ } resolvedPath = TclResolveTildePath(NULL, objv[i]); if (resolvedPath) { diff --git a/generic/tclPipe.c b/generic/tclPipe.c index 854ecd5..cc535ae 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -1021,7 +1021,7 @@ Tcl_Channel Tcl_OpenCommandChannel( Tcl_Interp *interp, /* Interpreter for error reporting. Can NOT be * NULL. */ - Tcl_Size argc, /* How many arguments. */ + Tcl_Size argc, /* How many arguments. */ const char **argv, /* Array of arguments for command pipe. */ int flags) /* Or'ed combination of TCL_STDIN, TCL_STDOUT, * TCL_STDERR, and TCL_ENFORCE_MODE. */ diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 50884a1..ffc038d 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -96,26 +96,36 @@ static void AddRequirementsToResult(Tcl_Interp *interp, int reqc, static void AddRequirementsToDString(Tcl_DString *dstring, int reqc, Tcl_Obj *const reqv[]); static Package * FindPackage(Tcl_Interp *interp, const char *name); -static int PkgRequireCore(void *data[], Tcl_Interp *interp, int result); -static int PkgRequireCoreFinal(void *data[], Tcl_Interp *interp, int result); -static int PkgRequireCoreCleanup(void *data[], Tcl_Interp *interp, int result); -static int PkgRequireCoreStep1(void *data[], Tcl_Interp *interp, int result); -static int PkgRequireCoreStep2(void *data[], Tcl_Interp *interp, int result); -static int TclNRPkgRequireProc(void *clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]); -static int SelectPackage(void *data[], Tcl_Interp *interp, int result); -static int SelectPackageFinal(void *data[], Tcl_Interp *interp, int result); -static int TclNRPackageObjCmdCleanup(void *data[], Tcl_Interp *interp, int result); +static int PkgRequireCore(void *data[], Tcl_Interp *interp, + int result); +static int PkgRequireCoreFinal(void *data[], Tcl_Interp *interp, + int result); +static int PkgRequireCoreCleanup(void *data[], Tcl_Interp *interp, + int result); +static int PkgRequireCoreStep1(void *data[], Tcl_Interp *interp, + int result); +static int PkgRequireCoreStep2(void *data[], Tcl_Interp *interp, + int result); +static int TclNRPkgRequireProc(void *clientData, + Tcl_Interp *interp, int reqc, + Tcl_Obj *const reqv[]); +static int SelectPackage(void *data[], Tcl_Interp *interp, + int result); +static int SelectPackageFinal(void *data[], Tcl_Interp *interp, + int result); +static int TclNRPackageObjCmdCleanup(void *data[], + Tcl_Interp *interp, int result); /* * Helper macros. */ -#define DupBlock(v,s,len) \ - ((v) = (char *)Tcl_Alloc(len), memcpy((v),(s),(len))) -#define DupString(v,s) \ - do { \ - size_t local__len = strlen(s) + 1; \ - DupBlock((v),(s),local__len); \ +#define DupBlock(var, str, len) \ + ((var) = (char *) Tcl_Alloc(len), memcpy((var), (str), (len))) +#define DupString(var, str) \ + do { \ + size_t local__len = strlen(str) + 1; \ + DupBlock((var), (str), local__len); \ } while (0) /* @@ -1250,7 +1260,7 @@ TclNRPackageObjCmd( hPtr = Tcl_NextHashEntry(&search)) { pkgPtr = (Package *)Tcl_GetHashValue(hPtr); if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) { - Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj( + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( (char *)Tcl_GetHashKey(tablePtr, hPtr), -1)); } } @@ -1365,7 +1375,7 @@ TclNRPackageObjCmd( TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, - TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL,NULL); + TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL, NULL); Tcl_NRAddCallback(interp, PkgRequireCore, (void *) argv3, INT2PTR(newobjc), newObjvPtr, NULL); @@ -1391,7 +1401,7 @@ TclNRPackageObjCmd( } TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, - TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL,NULL); + TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL, NULL); Tcl_NRAddCallback(interp, PkgRequireCore, (void *) argv2, INT2PTR(newobjc), newObjvPtr, NULL); diff --git a/generic/tclPosixStr.c b/generic/tclPosixStr.c index 52d5f09..7d7653c 100644 --- a/generic/tclPosixStr.c +++ b/generic/tclPosixStr.c @@ -524,7 +524,7 @@ Tcl_ErrnoId(void) const char * Tcl_ErrnoMsg( - int err) /* Error number (such as in errno variable). */ + int err) /* Error number (such as in errno variable). */ { switch (err) { #if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW)) @@ -1022,7 +1022,7 @@ Tcl_ErrnoMsg( const char * Tcl_SignalId( - int sig) /* Number of signal. */ + int sig) /* Number of signal. */ { switch (sig) { #ifdef SIGABRT @@ -1156,7 +1156,7 @@ Tcl_SignalId( const char * Tcl_SignalMsg( - int sig) /* Number of signal. */ + int sig) /* Number of signal. */ { switch (sig) { #ifdef SIGABRT diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c index 36a9537..58bc82d 100644 --- a/generic/tclPreserve.c +++ b/generic/tclPreserve.c @@ -21,7 +21,7 @@ */ typedef struct { - void *clientData; /* Address of preserved block. */ + void *clientData; /* Address of preserved block. */ size_t refCount; /* Number of Tcl_Preserve calls in effect for * block. */ int mustFree; /* Non-zero means Tcl_EventuallyFree was @@ -36,10 +36,11 @@ typedef struct { * These variables are protected by "preserveMutex". */ -static Reference *refArray = NULL; /* First in array of references. */ +static Reference *refArray = NULL; + /* First in array of references. */ static size_t spaceAvl = 0; /* Total number of structures available at * *firstRefPtr. */ -static size_t inUse = 0; /* Count of structures currently in use in +static size_t inUse = 0; /* Count of structures currently in use in * refArray. */ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */ @@ -117,7 +118,7 @@ TclFinalizePreserve(void) void Tcl_Preserve( - void *clientData) /* Pointer to malloc'ed block of memory. */ + void *clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; size_t i; @@ -180,7 +181,7 @@ Tcl_Preserve( void Tcl_Release( - void *clientData) /* Pointer to malloc'ed block of memory. */ + void *clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; size_t i; @@ -259,7 +260,7 @@ Tcl_Release( void Tcl_EventuallyFree( - void *clientData, /* Pointer to malloc'ed block of memory. */ + void *clientData, /* Pointer to malloc'ed block of memory. */ Tcl_FreeProc *freeProc) /* Function to actually do free. */ { Reference *refPtr; diff --git a/generic/tclProc.c b/generic/tclProc.c index 2f87048..0dfdec8 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -902,7 +902,6 @@ TclNRUplevelObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; @@ -911,11 +910,11 @@ TclNRUplevelObjCmd( Tcl_Obj *objPtr; if (objc < 2) { - /* to do - * simplify things by interpreting the argument as a command when there - * is only one argument. This requires a TIP since currently a single - * argument is interpreted as a level indicator if possible. - */ + /* to do: + * simplify things by interpreting the argument as a command when there + * is only one argument. This requires a TIP since currently a single + * argument is interpreted as a level indicator if possible. + */ uplevelSyntax: Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?"); return TCL_ERROR; @@ -1746,7 +1745,8 @@ TclNRInterpProcCore( } if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) { Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr); - const char *a[6]; Tcl_Size i[2]; + const char *a[6]; + Tcl_Size i[2]; TclDTraceInfo(info, a, i); TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); @@ -2108,7 +2108,7 @@ MakeProcError( void TclProcDeleteProc( - void *clientData) /* Procedure to be deleted. */ + void *clientData) /* Procedure to be deleted. */ { Proc *procPtr = (Proc *)clientData; diff --git a/generic/tclProcess.c b/generic/tclProcess.c index a5607d9..43b8cb4 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -40,7 +40,7 @@ static Tcl_HashTable infoTablePerResolvedPid; static int infoTablesInitialized = 0; /* 0 means not yet initialized. */ TCL_DECLARE_MUTEX(infoTablesMutex) - /* +/* * Prototypes for functions defined later in this file: */ diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 04f060b..caf6461 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -103,11 +103,11 @@ static int SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); */ const Tcl_ObjType tclRegexpType = { - "regexp", /* name */ - FreeRegexpInternalRep, /* freeIntRepProc */ - DupRegexpInternalRep, /* dupIntRepProc */ - NULL, /* updateStringProc */ - SetRegexpFromAny, /* setFromAnyProc */ + "regexp", /* name */ + FreeRegexpInternalRep, /* freeIntRepProc */ + DupRegexpInternalRep, /* dupIntRepProc */ + NULL, /* updateStringProc */ + SetRegexpFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; diff --git a/generic/tclResult.c b/generic/tclResult.c index 7151fc4..e9b2c1f 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -441,7 +441,7 @@ Tcl_ResetResult( static void ResetObjResult( - Interp *iPtr) /* Points to the interpreter whose result + Interp *iPtr) /* Points to the interpreter whose result * object should be reset. */ { Tcl_Obj *objResultPtr = iPtr->objResultPtr; @@ -551,7 +551,7 @@ Tcl_SetObjErrorCode( * * Tcl_GetErrorLine -- * - * Returns the line number associated with the current error. + * Returns the line number associated with the current error. * *---------------------------------------------------------------------- */ @@ -568,7 +568,7 @@ Tcl_GetErrorLine( * * Tcl_SetErrorLine -- * - * Sets the line number associated with the current error. + * Sets the line number associated with the current error. * *---------------------------------------------------------------------- */ @@ -716,7 +716,7 @@ TclProcessReturn( iPtr->errorInfo = NULL; } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { Tcl_Size length; @@ -728,41 +728,41 @@ TclProcessReturn( } } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { - Tcl_Size len, valueObjc; - Tcl_Obj **valueObjv; - - if (Tcl_IsShared(iPtr->errorStack)) { - Tcl_Obj *newObj; - - newObj = Tcl_DuplicateObj(iPtr->errorStack); - Tcl_DecrRefCount(iPtr->errorStack); - Tcl_IncrRefCount(newObj); - iPtr->errorStack = newObj; - } - - /* - * List extraction done after duplication to avoid moving the rug - * if someone does [return -errorstack [info errorstack]] - */ - - if (TclListObjGetElements(interp, valuePtr, &valueObjc, - &valueObjv) == TCL_ERROR) { - return TCL_ERROR; - } - iPtr->resetErrorStack = 0; - TclListObjLength(interp, iPtr->errorStack, &len); - - /* - * Reset while keeping the list internalrep as much as possible. - */ - - Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc, - valueObjv); + Tcl_Size len, valueObjc; + Tcl_Obj **valueObjv; + + if (Tcl_IsShared(iPtr->errorStack)) { + Tcl_Obj *newObj; + + newObj = Tcl_DuplicateObj(iPtr->errorStack); + Tcl_DecrRefCount(iPtr->errorStack); + Tcl_IncrRefCount(newObj); + iPtr->errorStack = newObj; + } + + /* + * List extraction done after duplication to avoid moving the rug + * if someone does [return -errorstack [info errorstack]] + */ + + if (TclListObjGetElements(interp, valuePtr, &valueObjc, + &valueObjv) == TCL_ERROR) { + return TCL_ERROR; + } + iPtr->resetErrorStack = 0; + TclListObjLength(interp, iPtr->errorStack, &len); + + /* + * Reset while keeping the list internalrep as much as possible. + */ + + Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc, + valueObjv); } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { Tcl_SetObjErrorCode(interp, valuePtr); } else { @@ -770,7 +770,7 @@ TclProcessReturn( } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine); } @@ -843,8 +843,8 @@ TclMergeReturnOptions( */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad %s value: expected dictionary but got \"%s\"", - compare, TclGetString(objv[1]))); + "bad %s value: expected dictionary but got \"%s\"", + compare, TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", (void *)NULL); goto error; @@ -874,7 +874,7 @@ TclMergeReturnOptions( Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr); if (valuePtr != NULL) { if (TclGetCompletionCodeFromObj(interp, valuePtr, - &code) == TCL_ERROR) { + &code) == TCL_ERROR) { goto error; } Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]); @@ -893,8 +893,8 @@ TclMergeReturnOptions( */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -level value: expected non-negative integer but got" - " \"%s\"", TclGetString(valuePtr))); + "bad -level value: expected non-negative integer but got" + " \"%s\"", TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", (void *)NULL); goto error; } @@ -915,8 +915,8 @@ TclMergeReturnOptions( */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -errorcode value: expected a list but got \"%s\"", - TclGetString(valuePtr))); + "bad -errorcode value: expected a list but got \"%s\"", + TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE", (void *)NULL); goto error; @@ -937,24 +937,24 @@ TclMergeReturnOptions( */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -errorstack value: expected a list but got \"%s\"", - TclGetString(valuePtr))); + "bad -errorstack value: expected a list but got \"%s\"", + TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK", - (void *)NULL); + (void *)NULL); goto error; } - if (length % 2) { - /* - * Errorstack must always be an even-sized list - */ + if (length % 2) { + /* + * Errorstack must always be an even-sized list + */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "forbidden odd-sized list for -errorstack: \"%s\"", + "forbidden odd-sized list for -errorstack: \"%s\"", TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", - "ODDSIZEDLIST_ERRORSTACK", (void *)NULL); + "ODDSIZEDLIST_ERRORSTACK", (void *)NULL); goto error; - } + } } /* @@ -1034,7 +1034,7 @@ Tcl_GetReturnOptions( if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, ""); - Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack); + Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack); } if (iPtr->errorCode) { Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode); @@ -1105,7 +1105,7 @@ Tcl_SetReturnOptions( if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv) || (objc % 2)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected dict but got \"%s\"", TclGetString(options))); + "expected dict but got \"%s\"", TclGetString(options))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", (void *)NULL); code = TCL_ERROR; } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv, diff --git a/generic/tclScan.c b/generic/tclScan.c index cccdd7a..ae23c3d 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -17,13 +17,13 @@ * Flag values used by Tcl_ScanObjCmd. */ -#define SCAN_NOSKIP 0x1 /* Don't skip blanks. */ -#define SCAN_SUPPRESS 0x2 /* Suppress assignment. */ -#define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */ -#define SCAN_WIDTH 0x8 /* A width value was supplied. */ +#define SCAN_NOSKIP 0x1 /* Don't skip blanks. */ +#define SCAN_SUPPRESS 0x2 /* Suppress assignment. */ +#define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */ +#define SCAN_WIDTH 0x8 /* A width value was supplied. */ -#define SCAN_LONGER 0x400 /* Asked for a wide value. */ -#define SCAN_BIG 0x800 /* Asked for a bignum value. */ +#define SCAN_LONGER 0x400 /* Asked for a wide value. */ +#define SCAN_BIG 0x800 /* Asked for a bignum value. */ /* * The following structure contains the information associated with a @@ -360,12 +360,10 @@ ValidateFormat( format - 1, (char **)&format, 10); /* INTL: "C" locale. */ /* Note >=, not >, to leave room for a nul */ if (ull >= TCL_SIZE_MAX) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("specified field width %" TCL_LL_MODIFIER - "u exceeds limit %" TCL_SIZE_MODIFIER "d.", - ull, - (Tcl_Size)TCL_SIZE_MAX-1)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "specified field width %" TCL_LL_MODIFIER + "u exceeds limit %" TCL_SIZE_MODIFIER "d.", + ull, (Tcl_Size)TCL_SIZE_MAX-1)); Tcl_SetErrorCode( interp, "TCL", "FORMAT", "WIDTHLIMIT", (void *)NULL); goto error; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 1b78184..da2343e 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -71,9 +71,9 @@ typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__))); # include # define TCL_IEEE_DOUBLE_ROUNDING_DECL # define TCL_IEEE_DOUBLE_ROUNDING \ - ieee_flags("set","precision","double",NULL) + ieee_flags("set", "precision", "double", NULL) # define TCL_DEFAULT_DOUBLE_ROUNDING \ - ieee_flags("clear","precision",NULL,NULL) + ieee_flags("clear", "precision", NULL, NULL) # endif #endif @@ -1696,7 +1696,7 @@ MakeLowPrecisionDouble( * ulp, so we need to change rounding mode to 53-bits. We also make * 'retval' volatile, so that it doesn't get promoted to a register. */ - volatile double retval; /* Value of the number. */ + volatile double retval; /* Value of the number. */ /* * Test for zero significand, which requires explicit construction @@ -2262,22 +2262,28 @@ NormalizeRightward( Tcl_WideUInt w = *wPtr; if (!(w & (Tcl_WideUInt) 0xFFFFFFFF)) { - w >>= 32; rv += 32; + w >>= 32; + rv += 32; } if (!(w & (Tcl_WideUInt) 0xFFFF)) { - w >>= 16; rv += 16; + w >>= 16; + rv += 16; } if (!(w & (Tcl_WideUInt) 0xFF)) { - w >>= 8; rv += 8; + w >>= 8; + rv += 8; } if (!(w & (Tcl_WideUInt) 0xF)) { - w >>= 4; rv += 4; + w >>= 4; + rv += 4; } if (!(w & 0x3)) { - w >>= 2; rv += 2; + w >>= 2; + rv += 2; } if (!(w & 0x1)) { - w >>= 1; ++rv; + w >>= 1; + ++rv; } *wPtr = w; return rv; @@ -2305,24 +2311,31 @@ RequiredPrecision( unsigned long wi; if (w & ((Tcl_WideUInt) 0xFFFFFFFF << 32)) { - wi = (unsigned long) (w >> 32); rv = 32; + wi = (unsigned long) (w >> 32); + rv = 32; } else { - wi = (unsigned long) w; rv = 0; + wi = (unsigned long) w; + rv = 0; } if (wi & 0xFFFF0000) { - wi >>= 16; rv += 16; + wi >>= 16; + rv += 16; } if (wi & 0xFF00) { - wi >>= 8; rv += 8; + wi >>= 8; + rv += 8; } if (wi & 0xF0) { - wi >>= 4; rv += 4; + wi >>= 4; + rv += 4; } if (wi & 0xC) { - wi >>= 2; rv += 2; + wi >>= 2; + rv += 2; } if (wi & 0x2) { - wi >>= 1; ++rv; + wi >>= 1; + ++rv; } if (wi & 0x1) { ++rv; @@ -2652,7 +2665,7 @@ ComputeScale( static inline void SetPrecisionLimits( - int flags, /* Type of conversion: TCL_DD_SHORTEST, + int flags, /* Type of conversion: TCL_DD_SHORTEST, * TCL_DD_E_FMT, TCL_DD_F_FMT. */ int k, /* Floor(log10(number to convert)) */ int *ndigitsPtr, /* IN/OUT: Number of digits requested (will be @@ -3148,7 +3161,9 @@ ShorteningInt64Conversion( if (b < S) { b = 10 * b; - ++m2plus; ++m2minus; ++m5; + ++m2plus; + ++m2minus; + ++m5; ilim = ilim1; --k; } @@ -3526,7 +3541,9 @@ ShorteningBignumConversionPowD( if ((err == MP_OKAY) && (b.used <= sd)) { err = mp_mul_d(&b, 10, &b); - ++m2plus; ++m2minus; ++m5; + ++m2plus; + ++m2minus; + ++m5; ilim = ilim1; --k; } @@ -3566,7 +3583,8 @@ ShorteningBignumConversionPowD( if (b.used > sd+1 || digit >= 10) { Tcl_Panic("wrong digit!"); } - --b.used; mp_clamp(&b); + --b.used; + mp_clamp(&b); } /* @@ -4542,9 +4560,11 @@ TclDoubleDigits( */ if (b2 >= s2 && s2 > 0) { - b2 -= s2; s2 = 0; + b2 -= s2; + s2 = 0; } else if (s2 >= b2 && b2 > 0) { - s2 -= b2; b2 = 0; + s2 -= b2; + b2 = 0; } if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] < 64) { @@ -4838,7 +4858,7 @@ Tcl_InitBignumFromDouble( double TclBignumToDouble( - const void *big) /* Integer to convert. */ + const void *big) /* Integer to convert. */ { mp_int b; int bits, shift, i, lsb; @@ -4959,7 +4979,7 @@ TclBignumToDouble( double TclCeil( - const void *big) /* Integer to convert. */ + const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; @@ -5025,7 +5045,7 @@ TclCeil( double TclFloor( - const void *big) /* Integer to convert. */ + const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 05c578e..1efaa67 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1,9 +1,9 @@ /* * tclStringObj.c -- * - * This file contains functions that implement string operations on Tcl - * objects. Some string operations work with UTF-8 encoding forms. - * Functions that require knowledge of the width of each character, + * This file contains functions that implement string operations on Tcl + * objects. Some string operations work with UTF-8 encoding forms. + * Functions that require knowledge of the width of each character, * such as indexing, operate on fixed width encoding forms such as UTF-32. * * Conceptually, a string is a sequence of Unicode code points. Internally @@ -15,10 +15,10 @@ * numChars, but we don't store the fixed form encoding (unless * Tcl_GetUnicode is explicitly called). * - * The String object type stores one or both formats. The default - * behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is - * stored in the internal rep for future access (without an additional - * O(n) cost). + * The String object type stores one or both formats. The default + * behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is + * stored in the internal rep for future access (without an additional + * O(n) cost). * * To allow many appends to be done to an object without constantly * reallocating space, we allocate double the space and use the @@ -124,8 +124,8 @@ const Tcl_ObjType tclStringType = { static void GrowStringBuffer( Tcl_Obj *objPtr, - Tcl_Size needed, /* Not including terminating nul */ - int flag) /* If 0, try to overallocate */ + Tcl_Size needed, /* Not including terminating nul */ + int flag) /* If 0, try to overallocate */ { /* * Preconditions: @@ -718,8 +718,8 @@ Tcl_GetUnicodeFromObj( Tcl_Obj * Tcl_GetRange( Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ - Tcl_Size first, /* First index of the range. */ - Tcl_Size last) /* Last index of the range. */ + Tcl_Size first, /* First index of the range. */ + Tcl_Size last) /* Last index of the range. */ { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ String *stringPtr; @@ -2557,8 +2557,8 @@ Tcl_AppendFormatToObj( } default: if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("bad field specifier \"%c\"", ch)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad field specifier \"%c\"", ch)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", (char *)NULL); } goto error; @@ -2760,7 +2760,7 @@ AppendPrintfToObjVA( } Tcl_ListObjAppendElement(NULL, list, - Tcl_NewStringObj(bytes , (end - bytes))); + Tcl_NewStringObj(bytes, (end - bytes))); break; } @@ -2805,11 +2805,11 @@ AppendPrintfToObjVA( case 'g': case 'G': if (size > 0) { - Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( - (double)va_arg(argList, long double))); + Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( + (double) va_arg(argList, long double))); } else { - Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( - va_arg(argList, double))); + Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( + va_arg(argList, double))); } seekingConversion = 0; break; @@ -3038,11 +3038,10 @@ TclStringRepeat( /* maxCount includes space for null */ if (count > (maxCount-1)) { if (interp) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("max size for a Tcl value (%" TCL_SIZE_MODIFIER - "d bytes) exceeded", - TCL_SIZE_MAX)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "max size for a Tcl value (%" TCL_SIZE_MODIFIER + "d bytes) exceeded", + TCL_SIZE_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); } return NULL; @@ -3269,7 +3268,8 @@ TclStringCat( } while (--oc); } else { /* Result will be concat of string reps. Pre-size it. */ - ov = objv; oc = objc; + ov = objv; + oc = objc; do { Tcl_Obj *pendingPtr = NULL; @@ -3353,7 +3353,8 @@ TclStringCat( return objv[first]; } - objv += first; objc = (last - first + 1); + objv += first; + objc = (last - first + 1); inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv); if (binary) { @@ -3368,7 +3369,8 @@ TclStringCat( if (inPlace) { Tcl_Size start = 0; - objResultPtr = *objv++; objc--; + objResultPtr = *objv++; + objc--; (void)Tcl_GetBytesFromObj(NULL, objResultPtr, &start); dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; } else { @@ -3398,7 +3400,8 @@ TclStringCat( if (inPlace) { Tcl_Size start; - objResultPtr = *objv++; objc--; + objResultPtr = *objv++; + objc--; /* Ugly interface! Force resize of the unicode array. */ (void)Tcl_GetUnicodeFromObj(objResultPtr, &start); @@ -3449,7 +3452,8 @@ TclStringCat( if (inPlace) { Tcl_Size start; - objResultPtr = *objv++; objc--; + objResultPtr = *objv++; + objc--; (void)TclGetStringFromObj(objResultPtr, &start); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { @@ -3521,9 +3525,9 @@ TclStringCat( static int UniCharNcasememcmp( - const void *ucsPtr, /* Unicode string to compare to uct. */ - const void *uctPtr, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of Unichars to compare. */ + const void *ucsPtr, /* Unicode string to compare to uct. */ + const void *uctPtr, /* Unicode string ucs is compared to. */ + size_t numChars) /* Number of Unichars to compare. */ { const Tcl_UniChar *ucs = (const Tcl_UniChar *)ucsPtr; const Tcl_UniChar *uct = (const Tcl_UniChar *)uctPtr; @@ -3544,7 +3548,7 @@ static int UtfNmemcmp( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; const char *cs = (const char *)csPtr; @@ -3576,7 +3580,7 @@ static int UtfNcasememcmp( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; const char *cs = (const char *)csPtr; @@ -3603,9 +3607,9 @@ UtfNcasememcmp( static int UniCharNmemcmp( - const void *ucsPtr, /* Unicode string to compare to uct. */ - const void *uctPtr, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of unichars to compare. */ + const void *ucsPtr, /* Unicode string to compare to uct. */ + const void *uctPtr, /* Unicode string ucs is compared to. */ + size_t numChars) /* Number of unichars to compare. */ { const Tcl_UniChar *ucs = (const Tcl_UniChar *)ucsPtr; const Tcl_UniChar *uct = (const Tcl_UniChar *)uctPtr; @@ -3637,7 +3641,7 @@ TclStringCmp( int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ Tcl_Size reqlength) /* requested length in characters; - * TCL_INDEX_NONE to compare whole strings */ + * TCL_INDEX_NONE to compare whole strings */ { const char *s1, *s2; int empty, match; @@ -3683,9 +3687,8 @@ TclStringCmp( && (value1Ptr->bytes != NULL) && (s2len == value2Ptr->length) && (value2Ptr->bytes != NULL)) { - /* each byte represents one character so s1l3n, s2l3n, and - * reqlength are in both bytes and characters - */ + /* each byte represents one character so s1l3n, s2l3n, and + * reqlength are in both bytes and characters */ s1 = value1Ptr->bytes; s2 = value2Ptr->bytes; memCmpFn = memcmp; diff --git a/generic/tclStubCall.c b/generic/tclStubCall.c index 29af44c..34bcb2f 100644 --- a/generic/tclStubCall.c +++ b/generic/tclStubCall.c @@ -9,8 +9,8 @@ #ifndef _WIN32 # include #else -# define dlopen(a,b) (void *)LoadLibraryW(JOIN(L,a)) -# define dlsym(a,b) (void *)GetProcAddress((HMODULE)(a),b) +# define dlopen(a, b) (void *)LoadLibraryW(JOIN(L, a)) +# define dlsym(a, b) (void *)GetProcAddress((HMODULE)(a), b) # define dlerror() "" #endif @@ -52,14 +52,15 @@ static const char PROCNAME[][24] = { }; MODULE_SCOPE const void *nullVersionProc(void) { - return NULL; + return NULL; } static const char CANNOTCALL[] = "Cannot call %s from stubbed extension\n"; static const char CANNOTFIND[] = "Cannot find %s: %s\n"; MODULE_SCOPE void * -TclStubCall(void *arg) +TclStubCall( + void *arg) { static void *stubFn[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}; size_t index = PTR2UINT(arg); diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 90501ff..f8b8d68 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -96,8 +96,13 @@ # define TclParseArgsObjv 0 # define TclGetAliasObj 0 #else /* !defined(TCL_NO_DEPRECATED) */ -int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, - void *objcPtr, Tcl_Obj ***objvPtr) { +int +TclListObjGetElements( + Tcl_Interp *interp, + Tcl_Obj *listPtr, + void *objcPtr, + Tcl_Obj ***objvPtr) +{ Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr); if (objcPtr) { @@ -111,8 +116,12 @@ int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, } return result; } -int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, - void *lengthPtr) { +int +TclListObjLength( + Tcl_Interp *interp, + Tcl_Obj *listPtr, + void *lengthPtr) +{ Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjLength(interp, listPtr, &n); if (lengthPtr) { @@ -126,8 +135,12 @@ int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, } return result; } -int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, - void *sizePtr) { +int +TclDictObjSize( + Tcl_Interp *interp, + Tcl_Obj *dictPtr, + void *sizePtr) +{ Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_DictObjSize(interp, dictPtr, &n); if (sizePtr) { @@ -141,8 +154,13 @@ int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, } return result; } -int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr, - const char ***argvPtr) { +int +TclSplitList( + Tcl_Interp *interp, + const char *listStr, + void *argcPtr, + const char ***argvPtr) +{ Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_SplitList(interp, listStr, &n, argvPtr); if (argcPtr) { @@ -157,7 +175,12 @@ int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr, } return result; } -void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) { +void +TclSplitPath( + const char *path, + void *argcPtr, + const char ***argvPtr) +{ Tcl_Size n = TCL_INDEX_NONE; Tcl_SplitPath(path, &n, argvPtr); if (argcPtr) { @@ -169,7 +192,11 @@ void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) { *(int *)argcPtr = (int)n; } } -Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) { +Tcl_Obj * +TclFSSplitPath( + Tcl_Obj *pathPtr, + void *lenPtr) +{ Tcl_Size n = TCL_INDEX_NONE; Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n); if (lenPtr) { @@ -181,17 +208,28 @@ Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) { } return result; } -int TclParseArgsObjv(Tcl_Interp *interp, - const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv, - Tcl_Obj ***remObjv) { +int +TclParseArgsObjv( + Tcl_Interp *interp, + const Tcl_ArgvInfo *argTable, + void *objcPtr, + Tcl_Obj *const *objv, + Tcl_Obj ***remObjv) +{ Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ; int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv); *(int *)objcPtr = (int)n; return result; } -int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd, - Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, - int *objcPtr, Tcl_Obj ***objv) { +int +TclGetAliasObj( + Tcl_Interp *interp, + const char *childCmd, + Tcl_Interp **targetInterpPtr, + const char **targetCmdPtr, + int *objcPtr, + Tcl_Obj ***objv) +{ Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, &n, objv); if (objcPtr) { @@ -306,7 +344,8 @@ doNothing(void) #define TclWinNoBackslash winNoBackslash static char * -TclWinNoBackslash(char *path) +TclWinNoBackslash( + char *path) { char *p; @@ -318,7 +357,8 @@ TclWinNoBackslash(char *path) return path; } -void *TclWinGetTclInstance(void) +void * +TclWinGetTclInstance(void) { void *hInstance = NULL; GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, @@ -327,7 +367,8 @@ void *TclWinGetTclInstance(void) } Tcl_Size -TclpGetPid(Tcl_Pid pid) +TclpGetPid( + Tcl_Pid pid) { return (Tcl_Size)PTR2INT(pid); } @@ -338,8 +379,14 @@ TclpGetPid(Tcl_Pid pid) * signature. Tcl 9 must find a better solution, but that cannot be done * without introducing a binary incompatibility. */ -#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))(void *)Tcl_GetIntFromObj -static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){ +#define Tcl_GetLongFromObj \ + (int(*)(Tcl_Interp*,Tcl_Obj*,long*))(void *)Tcl_GetIntFromObj +static int +exprInt( + Tcl_Interp *interp, + const char *expr, + int *ptr) +{ long longValue; int result = Tcl_ExprLong(interp, expr, &longValue); if (result == TCL_OK) { @@ -354,8 +401,14 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){ } return result; } -#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))(void *)exprInt -static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ +#define Tcl_ExprLong \ + (int(*)(Tcl_Interp*,const char*,long*))(void *)exprInt +static int +exprIntObj( + Tcl_Interp *interp, + Tcl_Obj*expr, + int *ptr) +{ long longValue; int result = Tcl_ExprLongObj(interp, expr, &longValue); if (result == TCL_OK) { @@ -402,10 +455,15 @@ MODULE_SCOPE const TclTomMathStubs tclTomMathStubs; #ifdef TCL_WITH_EXTERNAL_TOMMATH /* If Tcl is linked with an external libtommath 1.2.x, then mp_expt_n doesn't * exist (since that was introduced in libtommath 1.3.0. Provide it here.) */ -mp_err MP_WUR TclBN_mp_expt_n(const mp_int *a, int b, mp_int *c) { - if ((unsigned)b > MP_MIN(MP_DIGIT_MAX, INT_MAX)) { - return MP_VAL; - } +mp_err MP_WUR +TclBN_mp_expt_n( + const mp_int *a, + int b, + mp_int *c) +{ + if ((unsigned)b > MP_MIN(MP_DIGIT_MAX, INT_MAX)) { + return MP_VAL; + } return mp_expt_u32(a, (uint32_t)b, c);; } #endif /* TCL_WITH_EXTERNAL_TOMMATH */ diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 55001cf..d589199 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -92,7 +92,8 @@ Tcl_InitStubs( p = version; while (*p && (*p == *q)) { - p++; q++; + p++; + q++; } if (*p || ISDIGIT(*q)) { /* Construct error message */ diff --git a/generic/tclThread.c b/generic/tclThread.c index c107780..f9266ce 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -23,9 +23,9 @@ */ typedef struct { - int num; /* Number of objects remembered */ - int max; /* Max size of the array */ - void **list; /* List of pointers */ + int num; /* Number of objects remembered */ + int max; /* Max size of the array */ + void **list; /* List of pointers */ } SyncObjRecord; static SyncObjRecord keyRecord = {0, 0, NULL}; diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 011d61b..e7eb37e 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -92,7 +92,7 @@ typedef struct { size_t numRemoves; /* Number of removes from bucket */ size_t numInserts; /* Number of inserts into bucket */ size_t numLocks; /* Number of locks acquired */ - size_t totalAssigned; /* Total space assigned to bucket */ + size_t totalAssigned; /* Total space assigned to bucket */ } Bucket; /* @@ -120,7 +120,7 @@ typedef struct Cache { static struct { size_t blockSize; /* Bucket blocksize. */ size_t maxBlocks; /* Max blocks before move to share. */ - size_t numMove; /* Num blocks to move to share. */ + size_t numMove; /* Num blocks to move to share. */ Tcl_Mutex *lockPtr; /* Share bucket lock. */ } bucketInfo[NBUCKETS]; @@ -214,7 +214,7 @@ GetCache(void) if (cachePtr == NULL) { Tcl_Panic("alloc: could not allocate new cache"); } - memset(cachePtr, 0, sizeof(Cache)); + memset(cachePtr, 0, sizeof(Cache)); Tcl_MutexLock(listLockPtr); cachePtr->nextPtr = firstCachePtr; firstCachePtr = cachePtr; @@ -1035,7 +1035,7 @@ GetBlocks( * TclInitThreadAlloc -- * * Initializes the allocator cache-maintenance structures. - * It is done early and protected during the Tcl_InitSubsystems(). + * It is done early and protected during the Tcl_InitSubsystems(). * * Results: * None. diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c index 22dd0c3..3d79407 100644 --- a/generic/tclThreadStorage.c +++ b/generic/tclThreadStorage.c @@ -48,7 +48,7 @@ static struct { */ typedef struct { - void **tablePtr; /* The table of Tcl TSDs. */ + void **tablePtr; /* The table of Tcl TSDs. */ sig_atomic_t allocated; /* The size of the table in the current * thread. */ } TSDTable; diff --git a/generic/tclTimer.c b/generic/tclTimer.c index c5477bf..14c7087 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -21,7 +21,7 @@ typedef struct TimerHandler { Tcl_Time time; /* When timer is to fire. */ Tcl_TimerProc *proc; /* Function to call. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ Tcl_TimerToken token; /* Identifies handler so it can be deleted. */ struct TimerHandler *nextPtr; /* Next event in queue, or NULL for end of @@ -73,7 +73,7 @@ typedef struct AfterAssocData { typedef struct IdleHandler { Tcl_IdleProc *proc; /* Function to call. */ - void *clientData; /* Value to pass to proc. */ + void *clientData; /* Value to pass to proc. */ int generation; /* Used to distinguish older handlers from * recently-created ones. */ struct IdleHandler *nextPtr;/* Next in list of active handlers. */ @@ -251,7 +251,7 @@ Tcl_CreateTimerHandler( int milliseconds, /* How many milliseconds to wait before * invoking proc. */ Tcl_TimerProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { Tcl_Time time; @@ -619,7 +619,7 @@ TimerHandlerEventProc( void Tcl_DoWhenIdle( Tcl_IdleProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr; Tcl_Time blockTime; @@ -663,7 +663,7 @@ Tcl_DoWhenIdle( void Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr, *prevPtr; IdleHandler *nextPtr; @@ -823,10 +823,10 @@ Tcl_AfterObjCmd( const char *arg = TclGetString(objv[1]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad argument \"%s\": must be" - " cancel, idle, info, or an integer", arg)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", - arg, (void *)NULL); + "bad argument \"%s\": must be" + " cancel, idle, info, or an integer", arg)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", + arg, (void *)NULL); return TCL_ERROR; } } @@ -952,7 +952,7 @@ Tcl_AfterObjCmd( "after#%d", afterPtr->id)); } } - Tcl_SetObjResult(interp, resultObj); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (objc != 3) { @@ -961,11 +961,11 @@ Tcl_AfterObjCmd( } afterPtr = GetAfterEvent(assocPtr, objv[2]); if (afterPtr == NULL) { - const char *eventStr = TclGetString(objv[2]); + const char *eventStr = TclGetString(objv[2]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "event \"%s\" doesn't exist", eventStr)); - Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, (void *)NULL); + "event \"%s\" doesn't exist", eventStr)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "EVENT", eventStr, (void *)NULL); return TCL_ERROR; } else { Tcl_Obj *resultListPtr; @@ -975,7 +975,7 @@ Tcl_AfterObjCmd( afterPtr->commandPtr); Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( (afterPtr->token == NULL) ? "idle" : "timer", -1)); - Tcl_SetObjResult(interp, resultListPtr); + Tcl_SetObjResult(interp, resultListPtr); } break; default: @@ -1043,17 +1043,17 @@ AfterDelay( if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } - if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) { - diff = 1; - } + if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) { + diff = 1; + } if (diff > 0) { Tcl_Sleep((int) diff); - if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) { - break; - } + if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) { + break; + } } else { - break; - } + break; + } } else { diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now); if (diff > TCL_TIME_MAXIMUM_SLICE) { @@ -1149,7 +1149,7 @@ GetAfterEvent( static void AfterProc( - void *clientData) /* Describes command to execute. */ + void *clientData) /* Describes command to execute. */ { AfterInfo *afterPtr = (AfterInfo *)clientData; AfterAssocData *assocPtr = afterPtr->assocPtr; @@ -1214,7 +1214,7 @@ AfterProc( static void FreeAfterPtr( - AfterInfo *afterPtr) /* Command to be deleted. */ + AfterInfo *afterPtr) /* Command to be deleted. */ { AfterInfo *prevPtr; AfterAssocData *assocPtr = afterPtr->assocPtr; @@ -1251,7 +1251,7 @@ FreeAfterPtr( static void AfterCleanupProc( - void *clientData, /* Points to AfterAssocData for the + void *clientData, /* Points to AfterAssocData for the * interpreter. */ TCL_UNUSED(Tcl_Interp *)) { diff --git a/generic/tclTrace.c b/generic/tclTrace.c index f4e9fe5..6c48f81 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -22,7 +22,7 @@ typedef struct { int flags; /* Operations for which Tcl command is to be * invoked. */ Tcl_Size length; /* Number of non-NUL chars. in command. */ - char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual + char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual * size will be as large as necessary to hold * command. This field must be the last in the * structure, so that it can be larger than 1 @@ -44,7 +44,7 @@ typedef struct { Tcl_Size length; /* Number of non-NUL chars. in command. */ Tcl_Trace stepTrace; /* Used for execution traces, when tracing * inside the given command */ - Tcl_Size startLevel; /* Used for bookkeeping with step execution + Tcl_Size startLevel; /* Used for bookkeeping with step execution * traces, store the level at which the step * trace was invoked */ char *startCmd; /* Used for bookkeeping with step execution @@ -56,7 +56,7 @@ typedef struct { * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ - char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual + char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual * size will be as large as necessary to hold * command. This field must be the last in the * structure, so that it can be larger than 1 @@ -146,7 +146,7 @@ static int TraceVarEx(Tcl_Interp *interp, const char *part1, */ typedef struct { - void *clientData; /* Client data from Tcl_CreateTrace */ + void *clientData; /* Client data from Tcl_CreateTrace */ Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */ } StringTraceData; @@ -156,13 +156,13 @@ typedef struct { */ #define FOREACH_VAR_TRACE(interp, name, clientData) \ - (clientData) = NULL; \ - while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \ + (clientData) = NULL; \ + while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \ 0, TraceVarProc, (clientData))) != NULL) #define FOREACH_COMMAND_TRACE(interp, name, clientData) \ - (clientData) = NULL; \ - while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \ + (clientData) = NULL; \ + while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \ TraceCommandProc, (clientData))) != NULL) /* @@ -279,8 +279,9 @@ Tcl_TraceObjCmd( static int TraceExecutionObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + enum traceOptionsEnum optionIndex, + /* Add, info or remove */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *command; @@ -383,7 +384,7 @@ TraceExecutionObjCmd( */ name = TclGetString(objv[3]); - if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } @@ -526,8 +527,9 @@ TraceExecutionObjCmd( static int TraceCommandObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + enum traceOptionsEnum optionIndex, + /* Add, info or remove */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *command; @@ -616,7 +618,7 @@ TraceCommandObjCmd( */ name = TclGetString(objv[3]); - if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } @@ -720,8 +722,9 @@ TraceCommandObjCmd( static int TraceVariableObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + enum traceOptionsEnum optionIndex, + /* Add, info or remove */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *command; @@ -981,7 +984,7 @@ Tcl_TraceCommand( * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are * invoked upon cmdName. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { Command *cmdPtr; CommandTrace *tracePtr; @@ -1044,7 +1047,7 @@ Tcl_UntraceCommand( * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { CommandTrace *tracePtr; CommandTrace *prevPtr; @@ -1119,7 +1122,7 @@ Tcl_UntraceCommand( cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES; - /* + /* * Bug 3484621: up the interp's epoch if this is a BC'ed command */ @@ -1149,7 +1152,7 @@ Tcl_UntraceCommand( static void TraceCommandProc( - void *clientData, /* Information about the command trace. */ + void *clientData, /* Information about the command trace. */ Tcl_Interp *interp, /* Interpreter containing command. */ const char *oldName, /* Name of command being changed. */ const char *newName, /* New name of command. Empty string or NULL @@ -1294,7 +1297,7 @@ TclCheckExecutionTraces( Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ - Tcl_Size objc, /* Number of arguments for the command. */ + Tcl_Size objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; @@ -1400,7 +1403,7 @@ TclCheckInterpTraces( Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ - Tcl_Size objc, /* Number of arguments for the command. */ + Tcl_Size objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; @@ -1538,7 +1541,7 @@ TclCheckInterpTraces( static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ - Trace *tracePtr, /* Describes the trace function to call. */ + 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. */ @@ -1833,7 +1836,7 @@ TraceExecutionProc( static char * TraceVarProc( - void *clientData, /* Information about the variable trace. */ + void *clientData, /* Information about the variable trace. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable or array. */ const char *name2, /* Name of element within array; NULL means @@ -2016,10 +2019,10 @@ traceWrapperDelProc( Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Size level, /* Maximum nesting level */ + Tcl_Size level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc *proc, /* Trace callback */ - void *clientData, /* Client data for the callback */ + void *clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { @@ -2035,10 +2038,10 @@ Tcl_CreateObjTrace( Tcl_Trace Tcl_CreateObjTrace2( Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Size level, /* Maximum nesting level */ + Tcl_Size level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc2 *proc, /* Trace callback */ - void *clientData, /* Client data for the callback */ + void *clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { @@ -2124,11 +2127,11 @@ Tcl_CreateObjTrace2( Tcl_Trace Tcl_CreateTrace( Tcl_Interp *interp, /* Interpreter in which to create trace. */ - Tcl_Size level, /* Only call proc for commands at nesting + Tcl_Size level, /* Only call proc for commands at nesting * level<=argument level (1=>top level). */ Tcl_CmdTraceProc *proc, /* Function to call before executing each * command. */ - void *clientData) /* Arbitrary value word to pass to proc. */ + void *clientData) /* Arbitrary value word to pass to proc. */ { StringTraceData *data = (StringTraceData *)Tcl_Alloc(sizeof(StringTraceData)); @@ -2434,7 +2437,7 @@ TclCheckArrayTraces( int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - Var *arrayPtr, /* Pointer to array variable that contains the + 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. */ @@ -2468,7 +2471,7 @@ TclObjCallVarTraces( int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - Var *arrayPtr, /* Pointer to array variable that contains the + 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. */ @@ -2547,15 +2550,15 @@ TclCallVarTraces( /* Keep the original pointer for possible use in an error message */ element = part2; if (part2 == NULL) { - if (TclIsVarArrayElement(varPtr)) { - Tcl_Obj *keyObj = VarHashGetKey(varPtr); - part2 = Tcl_GetString(keyObj); - } + if (TclIsVarArrayElement(varPtr)) { + Tcl_Obj *keyObj = VarHashGetKey(varPtr); + part2 = Tcl_GetString(keyObj); + } } else if ((flags & VAR_TRACED_UNSET) && !(flags & VAR_ARRAY_ELEMENT)) { - /* On unset traces, part2 has already been set by the caller, and - * the VAR_ARRAY_ELEMENT flag indicates whether the accessed - * variable actually has a second part, or is a scalar */ - element = NULL; + /* On unset traces, part2 has already been set by the caller, and + * the VAR_ARRAY_ELEMENT flag indicates whether the accessed + * variable actually has a second part, or is a scalar */ + element = NULL; } /* @@ -2691,7 +2694,7 @@ TclCallVarTraces( } else { Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state); } - DisposeTraceResult(disposeFlags,result); + DisposeTraceResult(disposeFlags, result); } else if (state) { if (code == TCL_OK) { code = Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state); @@ -2776,7 +2779,7 @@ Tcl_UntraceVar2( * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function associated with trace. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; VarTrace *prevPtr, *nextPtr; @@ -2979,7 +2982,7 @@ Tcl_TraceVar2( * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function to call when specified ops are * invoked upon varName. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; int result; diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 03ea8b6..8bda8ac 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -132,7 +132,7 @@ TclUtfCount( * invalid in UTF-8. This might be because it is an overlong * encoding, or because it encodes something out of the proper range. * - * Given a pointer to the bytes \xF8 or \xFC , this routine will + * Given a pointer to the bytes \xF8 or \xFC, this routine will * try to read beyond the end of the "bounds" table. Callers must * prevent this. * @@ -161,7 +161,8 @@ static const unsigned char bounds[28] = { static int Invalid( - const char *src) /* Points to lead byte of a UTF-8 byte sequence */ + const char *src) /* Points to lead byte of a UTF-8 byte + * sequence. */ { unsigned char byte = UCHAR(*src); int index; @@ -309,7 +310,7 @@ three: char * Tcl_UniCharToUtfDString( - const int *uniStr, /* Unicode string to convert to UTF-8. */ + const int *uniStr, /* Unicode string to convert to UTF-8. */ Tcl_Size uniLength, /* Length of Unicode string. Negative for nul * terminated string */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended @@ -440,9 +441,9 @@ static const unsigned short cp1252[32] = { Tcl_Size Tcl_UtfToUniChar( - const char *src, /* The UTF-8 string. */ - int *chPtr)/* Filled with the Unicode character represented by - * the UTF-8 string. */ + const char *src, /* The UTF-8 string. */ + int *chPtr) /* Filled with the Unicode character + * represented by the UTF-8 string. */ { int byte; @@ -500,7 +501,8 @@ Tcl_UtfToUniChar( * represents itself. */ } else if (byte < 0xF5) { - if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { + if (((src[1] & 0xC0) == 0x80) + && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { /* * Four-byte-character lead byte followed by three trail bytes. */ @@ -523,9 +525,10 @@ Tcl_UtfToUniChar( Tcl_Size Tcl_UtfToChar16( - const char *src, /* The UTF-8 string. */ - unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by - * the UTF-8 string. This could be a surrogate too. */ + const char *src, /* The UTF-8 string. */ + unsigned short *chPtr) /* Filled with the Tcl_UniChar represented by + * the UTF-8 string. This could be a surrogate + * too. */ { unsigned short byte; @@ -801,9 +804,9 @@ Tcl_UtfCharComplete( Tcl_Size Tcl_NumUtfChars( - const char *src, /* The UTF-8 string to measure. */ - Tcl_Size length) /* The length of the string in bytes, or - * negative value for strlen(src). */ + const char *src, /* The UTF-8 string to measure. */ + Tcl_Size length) /* The length of the string in bytes, or + * negative value for strlen(src). */ { Tcl_UniChar ch = 0; Tcl_Size i = 0; @@ -853,9 +856,9 @@ Tcl_NumUtfChars( Tcl_Size TclNumUtfChars( - const char *src, /* The UTF-8 string to measure. */ - Tcl_Size length) /* The length of the string in bytes, or - * negative for strlen(src). */ + const char *src, /* The UTF-8 string to measure. */ + Tcl_Size length) /* The length of the string in bytes, or + * negative for strlen(src). */ { unsigned short ch = 0; Tcl_Size i = 0; @@ -1177,8 +1180,8 @@ Tcl_UtfPrev( int Tcl_UniCharAtIndex( - const char *src, /* The UTF-8 string to dereference. */ - Tcl_Size index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string to dereference. */ + Tcl_Size index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int i = 0; @@ -1213,8 +1216,8 @@ Tcl_UniCharAtIndex( const char * Tcl_UtfAtIndex( - const char *src, /* The UTF-8 string. */ - Tcl_Size index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string. */ + Tcl_Size index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; @@ -1226,8 +1229,8 @@ Tcl_UtfAtIndex( const char * TclUtfAtIndex( - const char *src, /* The UTF-8 string. */ - Tcl_Size index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string. */ + Tcl_Size index) /* The position of the desired character. */ { unsigned short ch = 0; Tcl_Size len = 0; @@ -1490,7 +1493,7 @@ int TclpUtfNcmp2( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ - size_t numBytes) /* Number of *bytes* to compare. */ + size_t numBytes) /* Number of *bytes* to compare. */ { const char *cs = (const char *)csPtr; const char *ct = (const char *)ctPtr; @@ -1523,8 +1526,8 @@ TclpUtfNcmp2( * * Tcl_UtfNcmp -- * - * Compare at most numChars chars (not bytes) of string cs to string ct. Both cs - * and ct are assumed to be at least numChars chars long. + * Compare at most numChars chars (not bytes) of string cs to string ct. + * Both cs and ct are assumed to be at least numChars chars long. * * Results: * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. @@ -1539,7 +1542,7 @@ int TclUtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF-16 chars to compare. */ + size_t numChars) /* Number of UTF-16 chars to compare. */ { unsigned short ch1 = 0, ch2 = 0; @@ -1552,18 +1555,18 @@ TclUtfNcmp( while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. This should be called - * only when both strings are of at least n UTF-16 chars long (no need for \0 - * check) + * only when both strings are of at least n UTF-16 chars long (no + * need for \0 check) */ cs += Tcl_UtfToChar16(cs, &ch1); ct += Tcl_UtfToChar16(ct, &ch2); if (ch1 != ch2) { /* Surrogates always report higher than non-surrogates */ - if (((ch1 & 0xFC00) == 0xD800)) { - if ((ch2 & 0xFC00) != 0xD800) { - return ch1; - } + if ((ch1 & 0xFC00) == 0xD800) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; } @@ -1577,7 +1580,7 @@ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1608,9 +1611,9 @@ Tcl_UtfNcmp( * * Tcl_UtfNcasecmp -- * - * Compare at most numChars chars (not bytes) of string cs to string ct case - * insensitive. Both cs and ct are assumed to be at least numChars UTF - * chars long. + * Compare at most numChars chars (not bytes) of string cs to string ct + * case insensitive. Both cs and ct are assumed to be at least numChars + * UTF-16 chars long. * * Results: * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. @@ -1625,7 +1628,7 @@ int TclUtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF-16 chars to compare. */ + size_t numChars) /* Number of UTF-16 chars to compare. */ { unsigned short ch1 = 0, ch2 = 0; @@ -1639,10 +1642,10 @@ TclUtfNcasecmp( ct += Tcl_UtfToChar16(ct, &ch2); if (ch1 != ch2) { /* Surrogates always report higher than non-surrogates */ - if (((ch1 & 0xFC00) == 0xD800)) { - if ((ch2 & 0xFC00) != 0xD800) { - return ch1; - } + if ((ch1 & 0xFC00) == 0xD800) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; } @@ -1660,7 +1663,7 @@ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1909,7 +1912,7 @@ Tcl_Char16Len( Tcl_Size Tcl_UniCharLen( - const int *uniStr) /* Unicode string to find length of. */ + const int *uniStr) /* Unicode string to find length of. */ { Tcl_Size len = 0; @@ -1941,7 +1944,7 @@ int TclUniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { #if defined(WORDS_BIGENDIAN) /* @@ -1969,8 +1972,8 @@ TclUniCharNcmp( * * TclUniCharNcasecmp -- * - * Compare at most numChars chars (not bytes) of string ucs to string uct case - * insensitive. Both ucs and uct are assumed to be at least numChars + * Compare at most numChars chars (not bytes) of string ucs to string uct + * case insensitive. Both ucs and uct are assumed to be at least numChars * chars long. * * Results: @@ -1986,7 +1989,7 @@ int TclUniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 3043fed..33ff5d4 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -124,11 +124,11 @@ static int FindElement(Tcl_Interp *interp, const char *string, */ static const Tcl_ObjType endOffsetType = { - "end-offset", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - NULL, /* updateStringProc */ - NULL, /* setFromAnyProc */ + "end-offset", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL, /* setFromAnyProc */ TCL_OBJTYPE_V1(TclLengthOne) }; @@ -946,9 +946,9 @@ Tcl_SplitList( Tcl_Size Tcl_ScanElement( - const char *src, /* String to convert to list element. */ - int *flagPtr) /* Where to store information to guide - * Tcl_ConvertCountedElement. */ + const char *src, /* String to convert to list element. */ + int *flagPtr) /* Where to store information to guide + * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, TCL_INDEX_NONE, flagPtr); } @@ -1036,7 +1036,7 @@ TclScanElement( Tcl_Size extra = 0; /* Count of number of extra bytes needed for * formatted element, assuming we use escape * sequences in formatting. */ - Tcl_Size bytesNeeded; /* Buffer length computed to complete the + Tcl_Size bytesNeeded; /* Buffer length computed to complete the * element formatting in the selected mode. */ #if COMPAT int preferEscape = 0; /* Use preferences to track whether to use */ @@ -1083,96 +1083,96 @@ TclScanElement( } while (length) { - if (CHAR_TYPE(*p) != TYPE_NORMAL) { - switch (*p) { - case '{': /* TYPE_BRACE */ + if (CHAR_TYPE(*p) != TYPE_NORMAL) { + switch (*p) { + case '{': /* TYPE_BRACE */ #if COMPAT - braceCount++; + braceCount++; #endif /* COMPAT */ - extra++; /* Escape '{' => '\{' */ - nestingLevel++; - break; - case '}': /* TYPE_BRACE */ + extra++; /* Escape '{' => '\{' */ + nestingLevel++; + break; + case '}': /* TYPE_BRACE */ #if COMPAT - braceCount++; + braceCount++; #endif /* COMPAT */ - extra++; /* Escape '}' => '\}' */ - if (nestingLevel-- < 1) { - /* - * Unbalanced braces! Cannot format with brace quoting. - */ + extra++; /* Escape '}' => '\}' */ + if (nestingLevel-- < 1) { + /* + * Unbalanced braces! Cannot format with brace quoting. + */ - requireEscape = 1; - } - break; - case ']': /* TYPE_CLOSE_BRACK */ - case '"': /* TYPE_SPACE */ + requireEscape = 1; + } + break; + case ']': /* TYPE_CLOSE_BRACK */ + case '"': /* TYPE_SPACE */ #if COMPAT - forbidNone = 1; - extra++; /* Escapes all just prepend a backslash */ - preferEscape = 1; - break; + forbidNone = 1; + extra++; /* Escapes all just prepend a backslash */ + preferEscape = 1; + break; #else - /* FLOW THROUGH */ + /* FLOW THROUGH */ #endif /* COMPAT */ - case '[': /* TYPE_SUBS */ - case '$': /* TYPE_SUBS */ - case ';': /* TYPE_COMMAND_END */ - forbidNone = 1; - extra++; /* Escape sequences all one byte longer. */ + case '[': /* TYPE_SUBS */ + case '$': /* TYPE_SUBS */ + case ';': /* TYPE_COMMAND_END */ + forbidNone = 1; + extra++; /* Escape sequences all one byte longer. */ #if COMPAT - preferBrace = 1; + preferBrace = 1; #endif /* COMPAT */ - break; - case '\\': /* TYPE_SUBS */ - extra++; /* Escape '\' => '\\' */ - if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) { - /* - * Final backslash. Cannot format with brace quoting. - */ - - requireEscape = 1; break; - } - if (p[1] == '\n') { - extra++; /* Escape newline => '\n', one byte longer */ + case '\\': /* TYPE_SUBS */ + extra++; /* Escape '\' => '\\' */ + if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) { + /* + * Final backslash. Cannot format with brace quoting. + */ + + requireEscape = 1; + break; + } + if (p[1] == '\n') { + extra++; /* Escape newline => '\n', one byte longer */ - /* - * Backslash newline sequence. Brace quoting not permitted. - */ + /* + * Backslash newline sequence. Brace quoting not permitted. + */ - requireEscape = 1; - length -= (length > 0); - p++; - break; - } - if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) { - extra++; /* Escape sequences all one byte longer. */ - length -= (length > 0); - p++; - } - forbidNone = 1; -#if COMPAT - preferBrace = 1; -#endif /* COMPAT */ - break; - case '\0': /* TYPE_SUBS */ - if (length == TCL_INDEX_NONE) { - goto endOfString; - } - /* TODO: Panic on improper encoding? */ - break; - default: - if (TclIsSpaceProcM(*p)) { + requireEscape = 1; + length -= (length > 0); + p++; + break; + } + if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) { + extra++; /* Escape sequences all one byte longer. */ + length -= (length > 0); + p++; + } forbidNone = 1; - extra++; /* Escape sequences all one byte longer. */ #if COMPAT preferBrace = 1; +#endif /* COMPAT */ + break; + case '\0': /* TYPE_SUBS */ + if (length == TCL_INDEX_NONE) { + goto endOfString; + } + /* TODO: Panic on improper encoding? */ + break; + default: + if (TclIsSpaceProcM(*p)) { + forbidNone = 1; + extra++; /* Escape sequences all one byte longer. */ +#if COMPAT + preferBrace = 1; #endif + } + break; } - break; } - } length -= (length > 0); p++; } @@ -1323,9 +1323,9 @@ TclScanElement( Tcl_Size 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. */ + 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, TCL_INDEX_NONE, dst, flags); } @@ -1353,7 +1353,7 @@ Tcl_ConvertElement( Tcl_Size Tcl_ConvertCountedElement( - const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ @@ -1386,7 +1386,7 @@ Tcl_ConvertCountedElement( Tcl_Size TclConvertElement( - const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ @@ -1406,7 +1406,8 @@ TclConvertElement( * No matter what the caller demands, empty string must be braced! */ - if ((src == NULL) || (length == 0) || (*src == '\0' && length == TCL_INDEX_NONE)) { + if ((src == NULL) || (length == 0) + || (*src == '\0' && length == TCL_INDEX_NONE)) { p[0] = '{'; p[1] = '}'; return 2; @@ -1567,7 +1568,7 @@ TclConvertElement( char * Tcl_Merge( - Tcl_Size argc, /* How many strings to merge. */ + Tcl_Size argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { #define LOCAL_SIZE 64 @@ -1644,14 +1645,14 @@ Tcl_Merge( Tcl_Size TclTrimRight( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim) /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim) /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (trim[numTrim] == '\0'). */ { const char *pp, *p = bytes + numBytes; int ch1, ch2; @@ -1723,14 +1724,14 @@ TclTrimRight( Tcl_Size TclTrimLeft( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim) /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim) /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (trim[numTrim] == '\0'). */ { const char *p = bytes; int ch1, ch2; @@ -1797,14 +1798,14 @@ TclTrimLeft( Tcl_Size TclTrim( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim, /* ...and its length in bytes */ - /* Calls in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim, /* ...and its length in bytes */ + /* Calls in this routine + * rely on (trim[numTrim] == '\0'). */ Tcl_Size *trimRightPtr) /* Offset from the end of the string. */ { Tcl_Size trimLeft = 0, trimRight = 0; @@ -1859,7 +1860,7 @@ TclTrim( char * Tcl_Concat( - Tcl_Size argc, /* Number of strings to concatenate. */ + Tcl_Size argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { Tcl_Size i, needSpace = 0, bytesNeeded = 0; @@ -2337,11 +2338,11 @@ Tcl_StringCaseMatch( int TclByteArrayMatch( const unsigned char *string,/* String. */ - Tcl_Size strLen, /* Length of String */ + Tcl_Size strLen, /* Length of String */ const unsigned char *pattern, /* Pattern, which may contain special * characters. */ - Tcl_Size ptnLen, /* Length of Pattern */ + Tcl_Size ptnLen, /* Length of Pattern */ TCL_UNUSED(int) /*flags*/) { const unsigned char *stringEnd, *patternEnd; @@ -2728,6 +2729,7 @@ Tcl_DStringAppendElement( * Backtrack over all whitespace. */ while ((--dst >= dsPtr->string) && TclIsSpaceProcM(*dst)) { + // empty body } /* Call again without whitespace to confound things. */ @@ -2809,7 +2811,7 @@ Tcl_DStringAppendElement( void Tcl_DStringSetLength( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ - Tcl_Size length) /* New length for dynamic string. */ + Tcl_Size length) /* New length for dynamic string. */ { Tcl_Size newsize; @@ -3242,9 +3244,10 @@ TclNeedSpace( */ while ((--end >= start) && (*end == '{')) { + // empty body } if (end < start) { - return 0; + return 0; } /* @@ -3298,7 +3301,7 @@ Tcl_Size TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ - Tcl_WideInt n) /* The integer to format. */ + Tcl_WideInt n) /* The integer to format. */ { Tcl_WideUInt intVal; int i = 0, numFormatted, j; @@ -3360,15 +3363,15 @@ TclFormatInt( static int GetWideForIndex( - Tcl_Interp *interp, /* Interpreter to use for error reporting. If + Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ - Tcl_Obj *objPtr, /* Points to the value to be parsed */ - Tcl_WideInt endValue, /* The value to be stored at *widePtr if + Tcl_Obj *objPtr, /* Points to the value to be parsed */ + Tcl_WideInt endValue, /* The value to be stored at *widePtr if * objPtr holds "end". - * NOTE: this value may be TCL_INDEX_NONE. */ - Tcl_WideInt *widePtr) /* Location filled in with a wide integer - * representing an index. */ + * NOTE: this value may be TCL_INDEX_NONE. */ + Tcl_WideInt *widePtr) /* Location filled in with a wide integer + * representing an index. */ { int numType; void *cd; @@ -3378,7 +3381,7 @@ GetWideForIndex( if (numType == TCL_NUMBER_INT) { /* objPtr holds an integer in the signed wide range */ *widePtr = *(Tcl_WideInt *)cd; - if ((*widePtr < 0)) { + if ((*widePtr < 0)) { *widePtr = (endValue == -1) ? WIDE_MIN : -1; } return TCL_OK; @@ -3409,7 +3412,7 @@ GetWideForIndex( * TCL_SIZE_MAX. Negative values are returned as TCL_INDEX_NONE (-1). * * Callers should pass reasonable values for endValue - one in the - * valid index range or TCL_INDEX_NONE (-1), for example for an empty + * valid index range or TCL_INDEX_NONE (-1), for example for an empty * list. * * Results: @@ -3453,10 +3456,10 @@ Tcl_GetIntForIndex( } else if (wide > TCL_SIZE_MAX) { *indexPtr = TCL_SIZE_MAX; /* Beyond max possible index */ } else if (wide < -1-TCL_SIZE_MAX) { - *indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */ - } else if ((wide < 0) && (endValue >= 0)) { - *indexPtr = TCL_INDEX_NONE; /* No clue why this special case */ - } else { + *indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */ + } else if ((wide < 0) && (endValue >= 0)) { + *indexPtr = TCL_INDEX_NONE; /* No clue why this special case */ + } else { *indexPtr = (Tcl_Size) wide; } } @@ -3480,7 +3483,7 @@ Tcl_GetIntForIndex( * -1: Index "end" * 0: Index "0" * WIDE_MAX-1: Index "end+n", for any n > 1. Distinguish from end+1 for - * commands like lset. + * commands like lset. * WIDE_MAX: Index "end+1" * * Results: @@ -3495,11 +3498,11 @@ Tcl_GetIntForIndex( static int GetEndOffsetFromObj( Tcl_Interp *interp, - Tcl_Obj *objPtr, /* Pointer to the object to parse */ - Tcl_WideInt endValue, /* The value to be stored at "widePtr" if - * "objPtr" holds "end". */ - Tcl_WideInt *widePtr) /* Location filled in with an integer - * representing an index. */ + Tcl_Obj *objPtr, /* Pointer to the object to parse */ + Tcl_WideInt endValue, /* The value to be stored at "widePtr" if + * "objPtr" holds "end". */ + Tcl_WideInt *widePtr) /* Location filled in with an integer + * representing an index. */ { Tcl_ObjInternalRep *irPtr; Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */ @@ -3532,14 +3535,14 @@ GetEndOffsetFromObj( */ if ((TclMaxListLength(bytes, TCL_INDEX_NONE, NULL) > 1) /* If it's possible, do the full list parse. */ - && (TCL_OK == TclListObjLength(NULL, objPtr, &length)) - && (length > 1)) { - goto parseError; + && (TCL_OK == TclListObjLength(NULL, objPtr, &length)) + && (length > 1)) { + goto parseError; } /* Passed the list screen, so parse for index arithmetic expression */ - if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE, &opPtr, - TCL_PARSE_INTEGER_ONLY)) { + if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, + TCL_INDEX_NONE, &opPtr, TCL_PARSE_INTEGER_ONLY)) { Tcl_WideInt w1=0, w2=0; /* value starts with valid integer... */ @@ -3698,12 +3701,12 @@ GetEndOffsetFromObj( if (offset == WIDE_MAX) { /* * Encodes end+1. This is distinguished from end+n as noted - * in function header. + * in function header. * NOTE: this may wrap around if the caller passes (as lset does) * listLen-1 as endValue and and listLen is 0. The -1 will be * interpreted as FF...FF and adding 1 will result in 0 which * is what we want. Callers like lset which pass in listLen-1 == -1 - * as endValue will have to adjust accordingly. + * as endValue will have to adjust accordingly. */ *widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1; } else if (offset == WIDE_MIN) { @@ -3724,14 +3727,14 @@ GetEndOffsetFromObj( /* Report a parse error. */ parseError: if (interp != NULL) { - char * bytes = TclGetString(objPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad index \"%s\": must be integer?[+-]integer? or" - " end?[+-]integer?", bytes)); - if (!strncmp(bytes, "end-", 4)) { - bytes += 4; - } - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL); + char * bytes = TclGetString(objPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\": must be integer?[+-]integer? or" + " end?[+-]integer?", bytes)); + if (!strncmp(bytes, "end-", 4)) { + bytes += 4; + } + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL); } return TCL_ERROR; @@ -3741,68 +3744,68 @@ GetEndOffsetFromObj( *---------------------------------------------------------------------- * * TclIndexEncode -- - * IMPORTANT: function only encodes indices in the range that fits within - * an "int" type. Do NOT change this as the byte code compiler and engine - * which call this function cannot handle wider index types. Indices - * outside the range will result in the function returning an error. + * IMPORTANT: function only encodes indices in the range that fits within + * an "int" type. Do NOT change this as the byte code compiler and engine + * which call this function cannot handle wider index types. Indices + * outside the range will result in the function returning an error. * - * Parse objPtr to determine if it is an index value. Two cases + * Parse objPtr to determine if it is an index value. Two cases * are possible. The value objPtr might be parsed as an absolute * index value in the Tcl_Size range. Note that this includes * index values that are integers as presented and it includes index - * arithmetic expressions. + * arithmetic expressions. * - * The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX. - * This means the largest supported character length is also TCL_SIZE_MAX, - * and the index of the last character in a string of length TCL_SIZE_MAX - * is TCL_SIZE_MAX-1. Thus the absolute index values that can be + * The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX. + * This means the largest supported character length is also TCL_SIZE_MAX, + * and the index of the last character in a string of length TCL_SIZE_MAX + * is TCL_SIZE_MAX-1. Thus the absolute index values that can be * directly meaningful as an index into either a list or a string are * integer values in the range 0 to TCL_SIZE_MAX - 1. * - * This function however can only handle integer indices in the range - * 0 : INT_MAX-1. - * - * Any absolute index value parsed outside that range is encoded - * using the before and after values passed in by the - * caller as the encoding to use for indices that are either - * less than or greater than the usable index range. TCL_INDEX_NONE - * is available as a good choice for most callers to use for - * after. Likewise, the value TCL_INDEX_NONE is good for - * most callers to use for before. Other values are possible - * when the caller knows it is helpful in producing its own behavior - * for indices before and after the indexed item. - * - * A token can also be parsed as an end-relative index expression. - * All end-relative expressions that indicate an index larger - * than end (end+2, end--5) point beyond the end of the indexed - * collection, and can be encoded as after. The end-relative - * expressions that indicate an index less than or equal to end - * are encoded relative to the value TCL_INDEX_END (-2). The - * index "end" is encoded as -2, down to the index "end-0x7FFFFFFE" - * which is encoded as INT_MIN. Since the largest index into a - * string possible in Tcl 8 is 0x7FFFFFFE, the interpretation of - * "end-0x7FFFFFFE" for that largest string would be 0. Thus, - * if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed, - * they can be encoded with the before value. + * This function however can only handle integer indices in the range + * 0 : INT_MAX-1. + * + * Any absolute index value parsed outside that range is encoded + * using the before and after values passed in by the + * caller as the encoding to use for indices that are either + * less than or greater than the usable index range. TCL_INDEX_NONE + * is available as a good choice for most callers to use for + * after. Likewise, the value TCL_INDEX_NONE is good for + * most callers to use for before. Other values are possible + * when the caller knows it is helpful in producing its own behavior + * for indices before and after the indexed item. + * + * A token can also be parsed as an end-relative index expression. + * All end-relative expressions that indicate an index larger + * than end (end+2, end--5) point beyond the end of the indexed + * collection, and can be encoded as after. The end-relative + * expressions that indicate an index less than or equal to end + * are encoded relative to the value TCL_INDEX_END (-2). The + * index "end" is encoded as -2, down to the index "end-0x7FFFFFFE" + * which is encoded as INT_MIN. Since the largest index into a + * string possible in Tcl 8 is 0x7FFFFFFE, the interpretation of + * "end-0x7FFFFFFE" for that largest string would be 0. Thus, + * if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed, + * they can be encoded with the before value. * * Returns: - * TCL_OK if parsing succeeded, and TCL_ERROR if it failed or the - * index does not fit in an int type. + * TCL_OK if parsing succeeded, and TCL_ERROR if it failed or the + * index does not fit in an int type. * * Side effects: - * When TCL_OK is returned, the encoded index value is written - * to *indexPtr. + * When TCL_OK is returned, the encoded index value is written + * to *indexPtr. * *---------------------------------------------------------------------- */ int TclIndexEncode( - Tcl_Interp *interp, /* For error reporting, may be NULL */ - Tcl_Obj *objPtr, /* Index value to parse */ - int before, /* Value to return for index before beginning */ - int after, /* Value to return for index after end */ - int *indexPtr) /* Where to write the encoded answer, not NULL */ + Tcl_Interp *interp, /* For error reporting, may be NULL */ + Tcl_Obj *objPtr, /* Index value to parse */ + int before, /* Value to return for index before beginning */ + int after, /* Value to return for index after end */ + int *indexPtr) /* Where to write the encoded answer, not NULL */ { Tcl_WideInt wide; int idx; @@ -3921,9 +3924,8 @@ TclIndexEncode( rangeerror: if (interp) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("index \"%s\" out of range", TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" out of range", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (void *)NULL); } return TCL_ERROR; @@ -3946,8 +3948,8 @@ rangeerror: Tcl_Size TclIndexDecode( - int encoded, /* Value to decode */ - Tcl_Size endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ + int encoded, /* Value to decode */ + Tcl_Size endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ { if (encoded > TCL_INDEX_END) { return encoded; @@ -3976,8 +3978,8 @@ TclIndexDecode( */ int TclCommandWordLimitError( - Tcl_Interp *interp, /* May be NULL */ - Tcl_Size count) /* If <= 0, "unknown" */ + Tcl_Interp *interp, /* May be NULL */ + Tcl_Size count) /* If <= 0, "unknown" */ { if (interp) { if (count > 0) { @@ -4043,11 +4045,11 @@ static Tcl_HashTable * GetThreadHash( Tcl_ThreadDataKey *keyPtr) { - Tcl_HashTable **tablePtrPtr = - (Tcl_HashTable **)Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *)); + Tcl_HashTable **tablePtrPtr = (Tcl_HashTable **) + Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *)); if (NULL == *tablePtrPtr) { - *tablePtrPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + *tablePtrPtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr); Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS); } @@ -4240,7 +4242,7 @@ TclGetProcessGlobalValue( Tcl_MutexLock(&pgvPtr->mutex); if ((NULL == pgvPtr->value) && (pgvPtr->proc)) { pgvPtr->epoch++; - pgvPtr->proc(&pgvPtr->value,&pgvPtr->numBytes,&pgvPtr->encoding); + pgvPtr->proc(&pgvPtr->value, &pgvPtr->numBytes, &pgvPtr->encoding); if (pgvPtr->value == NULL) { Tcl_Panic("PGV Initializer did not initialize"); } diff --git a/generic/tclVar.c b/generic/tclVar.c index 41bfa39..410b7ef 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -252,7 +252,7 @@ static const Tcl_ObjType localVarNameType = { TCL_OBJTYPE_V0 }; -#define LocalSetInternalRep(objPtr, index, namePtr) \ +#define LocalSetInternalRep(objPtr, index, namePtr) \ do { \ Tcl_ObjInternalRep ir; \ Tcl_Obj *ptr = (namePtr); \ @@ -262,12 +262,12 @@ static const Tcl_ObjType localVarNameType = { Tcl_StoreInternalRep((objPtr), &localVarNameType, &ir); \ } while (0) -#define LocalGetInternalRep(objPtr, index, name) \ +#define LocalGetInternalRep(objPtr, index, name) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &localVarNameType); \ - (name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ - (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &localVarNameType); \ + (name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ + (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \ } while (0) static const Tcl_ObjType parsedVarNameType = { @@ -276,7 +276,7 @@ static const Tcl_ObjType parsedVarNameType = { TCL_OBJTYPE_V0 }; -#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \ +#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \ do { \ Tcl_ObjInternalRep ir; \ Tcl_Obj *ptr1 = (arrayPtr); \ @@ -285,16 +285,16 @@ static const Tcl_ObjType parsedVarNameType = { if (ptr2) {Tcl_IncrRefCount(ptr2);} \ ir.twoPtrValue.ptr1 = ptr1; \ ir.twoPtrValue.ptr2 = ptr2; \ - Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir); \ + Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir); \ } while (0) -#define ParsedGetInternalRep(objPtr, parsed, array, elem) \ +#define ParsedGetInternalRep(objPtr, parsed, array, elem) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &parsedVarNameType); \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &parsedVarNameType); \ (parsed) = (irPtr != NULL); \ - (array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ - (elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ + (array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ + (elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) Var * @@ -344,8 +344,8 @@ NotArrayError( { const char *nameStr = TclGetString(name); - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("\"%s\" isn't an array", nameStr)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't an array", nameStr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, (char *)NULL); return TCL_ERROR; } @@ -531,7 +531,7 @@ TclLookupVar( Var * TclObjLookupVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ - Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an + 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. */ @@ -541,10 +541,10 @@ TclObjLookupVar( const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ - int createPart1, /* If 1, create hash table entry for part 1 of + int createPart1, /* If 1, create hash table entry for part 1 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ - int createPart2, /* If 1, create hash table entry for part 2 of + int createPart2, /* If 1, create hash table entry for part 2 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var **arrayPtrPtr) /* If the name refers to an element of an @@ -591,10 +591,10 @@ TclObjLookupVarEx( const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ - int createPart1, /* If 1, create hash table entry for part 1 of + int createPart1, /* If 1, create hash table entry for part 1 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ - int createPart2, /* If 1, create hash table entry for part 2 of + int createPart2, /* If 1, create hash table entry for part 2 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var **arrayPtrPtr) /* If the name refers to an element of an @@ -604,7 +604,7 @@ TclObjLookupVarEx( { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; - Var *varPtr; /* Points to the variable's in-frame Var + Var *varPtr; /* Points to the variable's in-frame Var * structure. */ const char *errMsg = NULL; int index, parsed = 0; @@ -827,7 +827,7 @@ TclLookupSimpleVar( int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG * bits matter. */ - int create, /* If 1, create hash table entry for varname, + int create, /* If 1, create hash table entry for varname, * if it doesn't already exist. If 0, return * error if it doesn't exist. */ const char **errMsgPtr, @@ -1025,7 +1025,7 @@ TclLookupSimpleVar( * element's name. * * Results: - * The return value is a pointer to the variable structure , or NULL if + * The return value is a pointer to the variable structure, or NULL if * the variable couldn't be found. * * If arrayPtr points to a variable that isn't an array and createPart1 @@ -1060,15 +1060,15 @@ TclLookupArrayElement( Tcl_Obj *arrayNamePtr, /* This is the name of the array, or NULL if * index>= 0. */ Tcl_Obj *elNamePtr, /* Name of element within array. */ - int flags, /* Only TCL_LEAVE_ERR_MSG bit matters. */ + int flags, /* Only TCL_LEAVE_ERR_MSG bit matters. */ const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ - int createArray, /* If 1, transform arrayName to be an array if + int createArray, /* If 1, transform arrayName to be an array if * it isn't one yet and the transformation is * possible. If 0, return error if it isn't * already an array. */ - int createElem, /* If 1, create hash table entry for the + int createElem, /* If 1, create hash table entry for the * element, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var *arrayPtr, /* Pointer to the array's Var structure. */ @@ -1277,10 +1277,10 @@ 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 + 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 + 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 @@ -1336,7 +1336,7 @@ TclPtrGetVar( * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ - int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { if (varPtr == NULL) { @@ -1375,14 +1375,14 @@ Tcl_Obj * TclPtrGetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - Var *varPtr, /* The variable to be read.*/ + 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. */ - int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is @@ -1483,14 +1483,14 @@ TclPtrGetVarIdx( int Tcl_SetObjCmd( TCL_UNUSED(void *), - Tcl_Interp *interp,/* Current interpreter. */ + 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); + varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); if (varValueObj == NULL) { return TCL_ERROR; } @@ -1660,10 +1660,10 @@ 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 + 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 + 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. */ @@ -1731,7 +1731,7 @@ TclPtrSetVar( Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr, /* New value for variable. */ - int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { if (varPtr == NULL) { @@ -1900,7 +1900,7 @@ 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 *varPtr, /* Reference to the variable to set. */ Var *arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ @@ -1910,7 +1910,7 @@ TclPtrSetVarIdx( Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr, /* New value for variable. */ - int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ int index) /* Index of local var where part1 is to be * found. */ @@ -1949,7 +1949,7 @@ TclPtrSetVarIdx( */ if (TclIsVarConstant(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST,index); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST, index); Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL); } goto earlyError; @@ -1961,7 +1961,7 @@ TclPtrSetVarIdx( if (TclIsVarArray(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY,index); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY, index); Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", (char *)NULL); } goto earlyError; @@ -2169,7 +2169,7 @@ TclPtrIncrObjVar( * part1Ptr. */ Tcl_Obj *incrPtr, /* Increment value. */ /* TODO: Which of these flag values really make sense? */ - int flags) /* Various flags that tell how to incr value: + int flags) /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ @@ -2225,7 +2225,7 @@ TclPtrIncrObjVarIdx( * part1Ptr. */ Tcl_Obj *incrPtr, /* Increment value. */ /* TODO: Which of these flag values really make sense? */ - int flags, /* Various flags that tell how to incr value: + int flags, /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ @@ -2240,7 +2240,7 @@ TclPtrIncrObjVarIdx( */ if (TclIsVarConstant(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST,index); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST, index); Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL); } return NULL; @@ -2414,7 +2414,7 @@ TclPtrUnsetVar( * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ - int flags) /* OR-ed combination of any of + int flags) /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { @@ -2477,7 +2477,7 @@ TclPtrUnsetVarIdx( */ if (TclIsVarConstant(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST,index); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST, index); Tcl_SetErrorCode(interp, "TCL", "UNSET", "CONST", (void *)NULL); } return TCL_ERROR; @@ -2505,7 +2505,8 @@ TclPtrUnsetVarIdx( if (result != TCL_OK) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", - ((initialArrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index); + ((initialArrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), + index); Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", (char *)NULL); } } @@ -2614,22 +2615,22 @@ UnsetVarStruct( if ((dummyVar.flags & VAR_TRACED_UNSET) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) { - /* - * Pass the array element name to TclObjCallVarTraces(), because - * it cannot be determined from dummyVar. Alternatively, indicate - * via flags whether the variable involved in the code that caused - * the trace to be triggered was an array element, for the correct - * formatting of error messages. - */ - if (part2Ptr) { - flags |= VAR_ARRAY_ELEMENT; - } else if (TclIsVarArrayElement(varPtr)) { - part2Ptr = VarHashGetKey(varPtr); - } + /* + * Pass the array element name to TclObjCallVarTraces(), because + * it cannot be determined from dummyVar. Alternatively, indicate + * via flags whether the variable involved in the code that caused + * the trace to be triggered was an array element, for the correct + * formatting of error messages. + */ + if (part2Ptr) { + flags |= VAR_ARRAY_ELEMENT; + } else if (TclIsVarArrayElement(varPtr)) { + part2Ptr = VarHashGetKey(varPtr); + } dummyVar.flags &= ~VAR_TRACE_ACTIVE; TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr, - (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT)) + (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT)) | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0, index); @@ -2813,7 +2814,7 @@ Tcl_AppendObjCmd( } if (objc == 2) { - varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG); + varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); if (varValuePtr == NULL) { return TCL_ERROR; } @@ -4301,7 +4302,7 @@ ArrayUnsetCmd( Tcl_Obj *varNameObj, *patternObj, *nameObj; Tcl_HashSearch search; const char *pattern; - int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */ + int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */ int isArray; switch (objc) { @@ -4480,7 +4481,7 @@ ObjMakeUpvar( * NULL means use global :: context. */ Tcl_Obj *otherP1Ptr, const char *otherP2, /* Two-part name of variable in framePtr. */ - int otherFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: + int otherFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of "other" variable. */ Tcl_Obj *myNamePtr, /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ @@ -4526,8 +4527,8 @@ ObjMakeUpvar( if (index < 0) { if (!(arrayPtr != NULL - ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) - : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr))) + ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) + : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr))) && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) || (varFramePtr == NULL) || !HasLocalVars(varFramePtr) @@ -5337,7 +5338,7 @@ ParseSearchId( static void DeleteSearches( Interp *iPtr, - Var *arrayVarPtr) /* Variable whose searches are to be + Var *arrayVarPtr) /* Variable whose searches are to be * deleted. */ { ArraySearch *searchPtr, *nextPtr; @@ -5610,7 +5611,7 @@ DeleteArray( elPtr->flags &= ~VAR_TRACE_ACTIVE; TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr, - elNamePtr, flags,/* leaveErrMsg */ 0, index); + elNamePtr, flags, /* leaveErrMsg */ 0, index); } tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr); tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr); @@ -6806,7 +6807,7 @@ FreeVarEntry( static int CompareVarKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; @@ -7086,13 +7087,13 @@ SetArrayDefault( */ if (tablePtr->defaultObj) { - Tcl_DecrRefCount(tablePtr->defaultObj); - Tcl_DecrRefCount(tablePtr->defaultObj); + Tcl_DecrRefCount(tablePtr->defaultObj); + Tcl_DecrRefCount(tablePtr->defaultObj); } tablePtr->defaultObj = defaultObj; if (tablePtr->defaultObj) { - Tcl_IncrRefCount(tablePtr->defaultObj); - Tcl_IncrRefCount(tablePtr->defaultObj); + Tcl_IncrRefCount(tablePtr->defaultObj); + Tcl_IncrRefCount(tablePtr->defaultObj); } } diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index b0bb383..679934f 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -45,7 +45,7 @@ * Macros to report errors only if an interp is present. */ -#define ZIPFS_ERROR(interp,errstr) \ +#define ZIPFS_ERROR(interp, errstr) \ do { \ if (interp) { \ Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); \ @@ -59,14 +59,14 @@ Tcl_SetErrorCode(interp, "TCL", "MALLOC", (char *)NULL); \ } \ } while (0) -#define ZIPFS_POSIX_ERROR(interp,errstr) \ +#define ZIPFS_POSIX_ERROR(interp, errstr) \ do { \ if (interp) { \ Tcl_SetObjResult(interp, Tcl_ObjPrintf( \ "%s: %s", errstr, Tcl_PosixError(interp))); \ } \ } while (0) -#define ZIPFS_ERROR_CODE(interp,errcode) \ +#define ZIPFS_ERROR_CODE(interp, errcode) \ do { \ if (interp) { \ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", errcode, (char *)NULL); \ @@ -196,7 +196,7 @@ typedef struct ZipFile { size_t baseOffset; /* Archive start */ size_t passOffset; /* Password start */ size_t directoryOffset; /* Archive directory start */ - size_t directorySize; /* Size of archive directory */ + size_t directorySize; /* Size of archive directory */ unsigned char passBuf[264]; /* Password buffer */ size_t numOpen; /* Number of open files on archive */ struct ZipEntry *entries; /* List of files in archive */ @@ -258,10 +258,10 @@ typedef struct ZipChannel { Tcl_Size cursor; /* Seek position for next read or write*/ unsigned char *ubuf; /* Pointer to the uncompressed data */ unsigned char *ubufToFree; /* NULL if ubuf points to memory that does not - need freeing. Else memory to free (ubuf - may point *inside* the block) */ + * need freeing. Else memory to free (ubuf + * may point *inside* the block) */ Tcl_Size ubufSize; /* Size of allocated ubufToFree */ - int iscompr; /* True if data is compressed */ + int isCompressed; /* True if data is compressed */ int isDirectory; /* Set to 1 if directory, or -1 if root */ int isEncrypted; /* True if data is encrypted */ int mode; /* O_WRITE, O_APPEND, O_TRUNC etc.*/ @@ -1393,9 +1393,9 @@ ZipFSCloseArchive( * into the given "interp" if it is not NULL. * * Side effects: - * The given ZipFile struct is filled with information about the ZIP - * archive file. On error, ZipFSCloseArchive is called on zf but - * it is not freed. + * The given ZipFile struct is filled with information about the ZIP + * archive file. On error, ZipFSCloseArchive is called on zf but + * it is not freed. * *------------------------------------------------------------------------- */ @@ -1594,7 +1594,7 @@ ZipFSFindTOC( * Results: * TCL_OK on success, TCL_ERROR otherwise with an error message placed * into the given "interp" if it is not NULL. On error, ZipFSCloseArchive - * is called on zf but it is not freed. + * is called on zf but it is not freed. * * Side effects: * ZIP archive is memory mapped or read into allocated memory, the given @@ -1660,7 +1660,7 @@ ZipFSOpenArchive( ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } - /* What's the magic about 64 * 1024 * 1024 ? */ + /* What's the magic about 64 * 1024 * 1024 ? */ if ((zf->length <= ZIP_CENTRAL_END_LEN) || (zf->length - ZIP_CENTRAL_END_LEN) > (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) { @@ -2230,7 +2230,8 @@ ListMountPoints( *------------------------------------------------------------------------ */ static void -CleanupMount(ZipFile *zf) /* Mount point */ +CleanupMount( + ZipFile *zf) /* Mount point */ { ZipEntry *z, *znext; Tcl_HashEntry *hPtr; @@ -3279,7 +3280,7 @@ ComputeNameInArchive( * archive */ const char *strip, /* A prefix to strip; may be NULL if no * stripping need be done. */ - Tcl_Size slen) /* The length of the prefix; must be 0 if no + Tcl_Size slen) /* The length of the prefix; must be 0 if no * stripping need be done. */ { const char *name; @@ -5115,7 +5116,7 @@ InitReadableChannel( unsigned char *ubuf = NULL; int ch; - info->iscompr = (z->compressMethod == ZIP_COMPMETH_DEFLATED); + info->isCompressed = (z->compressMethod == ZIP_COMPMETH_DEFLATED); info->ubuf = z->zipFilePtr->data + z->offset; info->ubufToFree = NULL; /* ubuf memory not allocated */ info->ubufSize = 0; @@ -5135,7 +5136,7 @@ InitReadableChannel( info->ubuf += ZIP_CRYPT_HDR_LEN; } - if (info->iscompr) { + if (info->isCompressed) { z_stream stream; int err; unsigned int j; @@ -5546,8 +5547,8 @@ ZipFSMatchInDirectoryProc( if ((wanted & TCL_GLOB_TYPE_MOUNT) && (wanted != TCL_GLOB_TYPE_MOUNT)) { if (interp) { ZIPFS_ERROR(interp, - "Internal error: TCL_GLOB_TYPE_MOUNT should not " - "be set in conjunction with other glob types."); + "Internal error: TCL_GLOB_TYPE_MOUNT should not " + "be set in conjunction with other glob types."); } return TCL_ERROR; } @@ -6518,7 +6519,7 @@ TclZipfs_Mount( Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(const char *), /* Path to ZIP file to mount. */ TCL_UNUSED(const char *), /* Mount point path. */ - TCL_UNUSED(const char *)) /* Password for opening the ZIP, or NULL if + TCL_UNUSED(const char *)) /* Password for opening the ZIP, or NULL if * the ZIP is unprotected. */ { ZIPFS_ERROR(interp, "no zlib available"); @@ -6555,7 +6556,7 @@ TclZipfs_AppHook( #ifdef _WIN32 TCL_UNUSED(WCHAR ***)) /* argvPtr */ #else /* !_WIN32 */ - TCL_UNUSED(char ***)) /* Pointer to argv */ + TCL_UNUSED(char ***)) /* Pointer to argv */ #endif /* _WIN32 */ { return NULL; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 595ddf4..dfaf7331e 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -3786,7 +3786,7 @@ ZlibStackChannelTransform( } switch (format) { - case TCL_ZLIB_FORMAT_RAW: + case TCL_ZLIB_FORMAT_RAW: wbits = WBITS_RAW; break; case TCL_ZLIB_FORMAT_ZLIB: diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 15b4fcd..24c0d20 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -84,11 +84,11 @@ static int SetOSTypeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfOSType(Tcl_Obj *objPtr); static const Tcl_ObjType tclOSTypeType = { - "osType", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - UpdateStringOfOSType, /* updateStringProc */ - SetOSTypeFromAny, /* setFromAnyProc */ + "osType", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + UpdateStringOfOSType, /* updateStringProc */ + SetOSTypeFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; @@ -691,7 +691,7 @@ SetOSTypeFromAny( static void UpdateStringOfOSType( - Tcl_Obj *objPtr) /* OSType object whose string rep to + Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { const size_t size = TCL_UTF_MAX * 4; diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index d8af241..48bac84 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -311,7 +311,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -999,7 +999,7 @@ TclpAlertNotifier( void TclpSetTimer( - const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ + const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { ThreadSpecificData *tsdPtr; CFRunLoopTimerRef runLoopTimer; @@ -1113,7 +1113,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -1907,7 +1907,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(void *), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 6158c99..fd9d752 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -29,7 +29,7 @@ extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #ifdef TCL_XT_TEST -extern void XtToolkitInitialize(void); +extern void XtToolkitInitialize(void); extern Tcl_LibraryInitProc Tclxttest_Init; #endif /* TCL_XT_TEST */ diff --git a/unix/tclEpollNotfy.c b/unix/tclEpollNotfy.c index 2a1733a..76377d3 100644 --- a/unix/tclEpollNotfy.c +++ b/unix/tclEpollNotfy.c @@ -42,7 +42,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -207,10 +207,10 @@ PlatformEventsControl( newEvent.events |= EPOLLOUT; } if (isNew) { - newPedPtr = (struct PlatformEventData *) + newPedPtr = (struct PlatformEventData *) Tcl_Alloc(sizeof(struct PlatformEventData)); - newPedPtr->filePtr = filePtr; - newPedPtr->tsdPtr = tsdPtr; + newPedPtr->filePtr = filePtr; + newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; } newEvent.data.ptr = filePtr->pedPtr; @@ -227,23 +227,22 @@ PlatformEventsControl( } if (epoll_ctl(tsdPtr->eventsFd, op, filePtr->fd, &newEvent) == -1) { - switch (errno) { - case EPERM: - switch (op) { - case EPOLL_CTL_ADD: - if (isNew) { - LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr, - readyNode); - } - break; - case EPOLL_CTL_DEL: - LIST_REMOVE(filePtr, readyNode); - break; - + switch (errno) { + case EPERM: + switch (op) { + case EPOLL_CTL_ADD: + if (isNew) { + LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, + filePtr, readyNode); } break; - default: - Tcl_Panic("epoll_ctl: %s", strerror(errno)); + case EPOLL_CTL_DEL: + LIST_REMOVE(filePtr, readyNode); + break; + } + break; + default: + Tcl_Panic("epoll_ctl: %s", strerror(errno)); } } return; @@ -367,7 +366,7 @@ PlatformEventsInit(void) filePtr->mask = TCL_READABLE; PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1); if (!tsdPtr->readyEvents) { - tsdPtr->maxReadyEvents = 512; + tsdPtr->maxReadyEvents = 512; tsdPtr->readyEvents = (struct epoll_event *) Tcl_Alloc( tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0])); } @@ -513,7 +512,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -791,7 +790,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - void *clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index ba49842..b58ab41 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -40,7 +40,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -517,7 +517,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -786,7 +786,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - void *clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index 54290ec..e0d8c53 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -148,7 +148,7 @@ TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ - Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded + Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, @@ -548,7 +548,7 @@ TclpLoadMemory( int codeSize, /* Size of code data read into buffer or -1 if * an error occurred and the buffer should * just be freed. */ - Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded + Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index de185fb..fc10162 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -61,7 +61,7 @@ TclpDlopen( const char *native; int result = 1; - NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE); + NXStream *errorStream = NXOpenMemory(0, 0, NX_READWRITE); fileName = TclGetString(pathPtr); @@ -72,7 +72,7 @@ TclpDlopen( */ native = Tcl_FSGetNativePath(pathPtr); - files = {native,NULL}; + files = {native, NULL}; result = rld_load(errorStream, &header, files, NULL); @@ -90,7 +90,7 @@ TclpDlopen( return TCL_ERROR; } native = Tcl_DStringValue(&ds); - files = {native,NULL}; + files = {native, NULL}; result = rld_load(errorStream, &header, files, NULL); Tcl_DStringFree(&ds); } diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 81f314f..9c34e73 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -128,7 +128,7 @@ TclpDlopen( */ if ((pkg = strrchr(fileName, '/')) == NULL) { - pkg = fileName; + pkg = fileName; } else { pkg++; } diff --git a/unix/tclSelectNotfy.c b/unix/tclSelectNotfy.c index bede898..7c74dfc 100644 --- a/unix/tclSelectNotfy.c +++ b/unix/tclSelectNotfy.c @@ -32,7 +32,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -480,7 +480,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -921,7 +921,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(void *), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 3f972ae..c04c4fa 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -30,7 +30,7 @@ # elif defined(FIORDCHK) # define GETREADQUEUE(fd, int) int = ioctl((fd), FIORDCHK, NULL) # else -# define GETREADQUEUE(fd, int) int = 0 +# define GETREADQUEUE(fd, int) int = 0 # endif # ifdef TIOCOUTQ @@ -162,10 +162,10 @@ static int TtySetOptionProc(void *instanceData, static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ - NULL, + NULL, NULL, /* Set option proc. */ FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ @@ -188,7 +188,7 @@ static const Tcl_ChannelType fileChannelType = { static const Tcl_ChannelType ttyChannelType = { "tty", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -196,7 +196,7 @@ static const Tcl_ChannelType ttyChannelType = { TtyGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ - TtyCloseProc, /* close2proc. */ + TtyCloseProc, /* New-style close proc. */ FileBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ @@ -225,7 +225,7 @@ static const Tcl_ChannelType ttyChannelType = { static int FileBlockModeProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ int mode) /* The mode to set. Can be TCL_MODE_BLOCKING * or TCL_MODE_NONBLOCKING. */ { @@ -258,7 +258,7 @@ FileBlockModeProc( static int FileInputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ char *buf, /* Where to store data read. */ int toRead, /* How much space is available in the * buffer? */ @@ -308,7 +308,7 @@ FileInputProc( static int FileOutputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ @@ -355,7 +355,7 @@ FileOutputProc( static int FileCloseProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -448,7 +448,7 @@ TtyCloseProc( static long long FileWideSeekProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? Can be * one of SEEK_START, SEEK_CUR or SEEK_END. */ @@ -496,7 +496,7 @@ FileWatchNotifyChannelWrapper( static void FileWatchProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -536,9 +536,9 @@ FileWatchProc( static int FileGetHandleProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { FileState *fsPtr = (FileState *)instanceData; @@ -773,7 +773,7 @@ TtyModemStatusStr( static int TtySetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ @@ -1113,7 +1113,7 @@ TtySetOptionProc( static int TtyGetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ @@ -1654,11 +1654,11 @@ TtyParseMode( if ( #if defined(PAREXT) - strchr("noems", parity) + strchr("noems", parity) #else - strchr("noe", parity) + strchr("noe", parity) #endif /* PAREXT */ - == NULL) { + == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s parity: should be %s", bad, @@ -2069,7 +2069,7 @@ Tcl_GetOpenFile( * Ignored, we always check that * the channel is open for the requested * mode. */ - void **filePtr) /* Store pointer to FILE structure here. */ + void **filePtr) /* Store pointer to FILE structure here. */ { Tcl_Channel chan; int chanMode, fd; diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 30ddb71..8b6a421 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -164,14 +164,14 @@ TclUnixSetBlockingMode( * * TclpGetPwNam -- * - * Thread-safe wrappers for getpwnam(). See "man getpwnam" for more - * details. + * Thread-safe wrappers for getpwnam(). See "man getpwnam" for more + * details. * * Results: - * Pointer to struct passwd on success or NULL on error. + * Pointer to struct passwd on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -244,14 +244,14 @@ TclpGetPwNam( * * TclpGetPwUid -- * - * Thread-safe wrappers for getpwuid(). See "man getpwuid" for more - * details. + * Thread-safe wrappers for getpwuid(). See "man getpwuid" for more + * details. * * Results: - * Pointer to struct passwd on success or NULL on error. + * Pointer to struct passwd on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -347,14 +347,14 @@ FreePwBuf( * * TclpGetGrNam -- * - * Thread-safe wrappers for getgrnam(). See "man getgrnam" for more - * details. + * Thread-safe wrappers for getgrnam(). See "man getgrnam" for more + * details. * * Results: - * Pointer to struct group on success or NULL on error. + * Pointer to struct group on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -427,14 +427,14 @@ TclpGetGrNam( * * TclpGetGrGid -- * - * Thread-safe wrappers for getgrgid(). See "man getgrgid" for more - * details. + * Thread-safe wrappers for getgrgid(). See "man getgrgid" for more + * details. * * Results: - * Pointer to struct group on success or NULL on error. + * Pointer to struct group on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -530,14 +530,14 @@ FreeGrBuf( * * TclpGetHostByName -- * - * Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for - * more details. + * Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for + * more details. * * Results: - * Pointer to struct hostent on success or NULL on error. + * Pointer to struct hostent on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -598,14 +598,14 @@ TclpGetHostByName( * * TclpGetHostByAddr -- * - * Thread-safe wrappers for gethostbyaddr(). See "man gethostbyaddr" for - * more details. + * Thread-safe wrappers for gethostbyaddr(). See "man gethostbyaddr" for + * more details. * * Results: - * Pointer to struct hostent on success or NULL on error. + * Pointer to struct hostent on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -661,14 +661,14 @@ TclpGetHostByAddr( * * CopyGrp -- * - * Copies string fields of the group structure to the private buffer, - * honouring the size of the buffer. + * Copies string fields of the group structure to the private buffer, + * honouring the size of the buffer. * * Results: - * 0 on success or -1 on error (errno = ERANGE). + * 0 on success or -1 on error (errno = ERANGE). * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -734,14 +734,14 @@ CopyGrp( * * CopyHostent -- * - * Copies string fields of the hostent structure to the private buffer, - * honouring the size of the buffer. + * Copies string fields of the hostent structure to the private buffer, + * honouring the size of the buffer. * * Results: - * Number of bytes copied on success or -1 on error (errno = ERANGE) + * Number of bytes copied on success or -1 on error (errno = ERANGE) * * Side effects: - * None + * None * *--------------------------------------------------------------------------- */ @@ -796,15 +796,15 @@ CopyHostent( * * CopyPwd -- * - * Copies string fields of the passwd structure to the private buffer, - * honouring the size of the buffer. + * Copies string fields of the passwd structure to the private buffer, + * honouring the size of the buffer. * * Results: - * 0 on success or -1 on error (errno = ERANGE). + * 0 on success or -1 on error (errno = ERANGE). * * Side effects: - * We are not copying the gecos field as it may not be supported on all - * platforms. + * We are not copying the gecos field as it may not be supported on all + * platforms. * *--------------------------------------------------------------------------- */ @@ -862,14 +862,14 @@ CopyPwd( * * CopyArray -- * - * Copies array of NULL-terminated or fixed-length strings to the private - * buffer, honouring the size of the buffer. + * Copies array of NULL-terminated or fixed-length strings to the private + * buffer, honouring the size of the buffer. * * Results: - * Number of bytes copied on success or -1 on error (errno = ERANGE) + * Number of bytes copied on success or -1 on error (errno = ERANGE) * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -926,14 +926,14 @@ CopyArray( * * CopyString -- * - * Copies a NULL-terminated string to the private buffer, honouring the - * size of the buffer + * Copies a NULL-terminated string to the private buffer, honouring the + * size of the buffer * * Results: - * 0 success or -1 on error (errno = ERANGE) + * 0 success or -1 on error (errno = ERANGE) * * Side effects: - * None + * None * *--------------------------------------------------------------------------- */ @@ -986,25 +986,27 @@ CopyString( int TclWinCPUID( - int index, /* Which CPUID value to retrieve. */ - int *regsPtr) /* Registers after the CPUID. */ + int index, /* Which CPUID value to retrieve. */ + int *regsPtr) /* Registers after the CPUID. */ { int status = TCL_ERROR; /* See: */ #if defined(__x86_64__) || defined(_M_AMD64) || defined (_M_X64) - __asm__ __volatile__("movq %%rbx, %%rsi \n\t" /* save %rbx */ - "cpuid \n\t" - "xchgq %%rsi, %%rbx \n\t" /* restore the old %rbx */ - : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) - : "a"(index)); + __asm__ __volatile__( + "movq %%rbx, %%rsi \n\t" /* save %rbx */ + "cpuid \n\t" + "xchgq %%rsi, %%rbx \n\t" /* restore the old %rbx */ + : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) + : "a"(index)); status = TCL_OK; #elif defined(__i386__) || defined(_M_IX86) - __asm__ __volatile__("mov %%ebx, %%esi \n\t" /* save %ebx */ - "cpuid \n\t" - "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */ - : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) - : "a"(index)); + __asm__ __volatile__( + "mov %%ebx, %%esi \n\t" /* save %ebx */ + "cpuid \n\t" + "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */ + : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) + : "a"(index)); status = TCL_OK; #else (void)index; diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index b65cdb1..b9348aa 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -14,7 +14,7 @@ * following copyright notice: * * Copyright © 1988, 1993, 1994 - * The Regents of the University of California. All rights reserved. + * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: @@ -757,7 +757,7 @@ TclpObjCopyDirectory( int ret; Tcl_Obj *transPtr; - transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); + transPtr = Tcl_FSGetTranslatedPath(NULL, srcPathPtr); ret = Tcl_UtfToExternalDStringEx(NULL, NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, 0, &srcString, NULL); @@ -767,7 +767,7 @@ TclpObjCopyDirectory( if (ret != TCL_OK) { *errorPtr = srcPathPtr; } else { - transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); + transPtr = Tcl_FSGetTranslatedPath(NULL, destPathPtr); ret = Tcl_UtfToExternalDStringEx(NULL, NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, TCL_ENCODING_PROFILE_TCL8, &dstString, NULL); @@ -1292,7 +1292,7 @@ TraversalDelete( static int CopyFileAtts( #ifdef MAC_OSX_TCL - const char *src, /* Path name of source file (native). */ + const char *src, /* Path name of source file (native). */ #else TCL_UNUSED(const char *) /*src*/, #endif @@ -1766,14 +1766,14 @@ TclpObjListVolumes(void) static int GetModeFromPermString( TCL_UNUSED(Tcl_Interp *), - const char *modeStringPtr, /* Permissions string */ + const char *modeStringPtr, /* Permissions string */ mode_t *modePtr) /* pointer to the mode value */ { mode_t newMode; mode_t oldMode; /* Storage for the value of the old mode (that * is passed in), to allow for the chmod style * manipulation. */ - int i,n, who, op, what, op_found, who_found; + int i, n, who, op, what, op_found, who_found; /* * We start off checking for an "rwxrwxrwx" style permissions string @@ -2075,7 +2075,7 @@ TclpObjNormalizePath( return 0; } - if (Tcl_UtfToExternalDStringEx(interp, NULL, path,nextCheckpoint, 0, &ds, NULL)) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, path, nextCheckpoint, 0, &ds, NULL)) { Tcl_DStringFree(&ds); return -1; } @@ -2488,10 +2488,10 @@ GetUnixFileAttributes( static int SetUnixFileAttributes( - Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file (UTF-8). */ - Tcl_Obj *attributePtr) /* The attribute to set. */ + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr) /* The attribute to set. */ { int yesNo, fileAttributes, old; WCHAR *winPath; diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 444c73f..95a0d9e 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -155,9 +155,11 @@ TclpFindExecutable( #endif { encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDStringEx(NULL, encoding, name, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &utfName, NULL); + Tcl_ExternalToUtfDStringEx(NULL, encoding, name, TCL_INDEX_NONE, + TCL_ENCODING_PROFILE_TCL8, &utfName, NULL); TclSetObjNameOfExecutable( - Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); + Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), + encoding); Tcl_DStringFree(&utfName); goto done; } @@ -192,10 +194,11 @@ TclpFindExecutable( Tcl_DStringFree(&nameString); encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDStringEx(NULL, encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE, - TCL_ENCODING_PROFILE_TCL8, &utfName, NULL); + Tcl_ExternalToUtfDStringEx(NULL, encoding, Tcl_DStringValue(&buffer), + TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &utfName, NULL); TclSetObjNameOfExecutable( - Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); + Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), + encoding); Tcl_DStringFree(&utfName); done: @@ -308,7 +311,8 @@ TclpMatchInDirectory( * Now open the directory for reading and iterate over the contents. */ - if (Tcl_UtfToExternalDStringEx(interp, NULL, dirName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, dirName, TCL_INDEX_NONE, + 0, &ds, NULL) != TCL_OK) { Tcl_DStringFree(&dsOrig); Tcl_DStringFree(&ds); Tcl_DecrRefCount(fileNamePtr); @@ -324,7 +328,7 @@ TclpMatchInDirectory( return TCL_OK; } - d = TclOSopendir(native); /* INTL: Native. */ + d = TclOSopendir(native); /* INTL: Native. */ if (d == NULL) { Tcl_DStringFree(&ds); if (interp != NULL) { @@ -378,8 +382,8 @@ TclpMatchInDirectory( * and pattern. If so, add the file to the result. */ - if (Tcl_ExternalToUtfDStringEx(interp, NULL, entryPtr->d_name, TCL_INDEX_NONE, - 0, &utfDs, NULL) != TCL_OK) { + if (Tcl_ExternalToUtfDStringEx(interp, NULL, entryPtr->d_name, + TCL_INDEX_NONE, 0, &utfDs, NULL) != TCL_OK) { matchResult = -1; break; } @@ -389,7 +393,8 @@ TclpMatchInDirectory( if (types != NULL) { Tcl_DStringSetLength(&ds, nativeDirLen); - native = Tcl_DStringAppend(&ds, entryPtr->d_name, TCL_INDEX_NONE); + native = Tcl_DStringAppend(&ds, entryPtr->d_name, + TCL_INDEX_NONE); matchResult = NativeMatchType(interp, native, entryPtr->d_name, types); typeOk = (matchResult == 1); @@ -438,10 +443,10 @@ TclpMatchInDirectory( static int NativeMatchType( - Tcl_Interp *interp, /* Interpreter to receive errors. */ - const char *nativeEntry, /* Native path to check. */ - const char *nativeName, /* Native filename to check. */ - Tcl_GlobTypeData *types) /* Type description to match against. */ + Tcl_Interp *interp, /* Interpreter to receive errors. */ + const char *nativeEntry, /* Native path to check. */ + const char *nativeName, /* Native filename to check. */ + Tcl_GlobTypeData *types) /* Type description to match against. */ { Tcl_StatBuf buf; @@ -611,7 +616,8 @@ TclpGetUserHome( Tcl_DString ds; const char *native; - if (Tcl_UtfToExternalDStringEx(NULL, NULL, name, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(NULL, NULL, name, TCL_INDEX_NONE, 0, &ds, + NULL) != TCL_OK) { Tcl_DStringFree(&ds); return NULL; } @@ -623,7 +629,8 @@ TclpGetUserHome( if (pwPtr == NULL) { return NULL; } - if (Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_dir, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) { + if (Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_dir, TCL_INDEX_NONE, + 0, bufferPtr, NULL) != TCL_OK) { return NULL; } else { return Tcl_DStringValue(bufferPtr); @@ -805,7 +812,8 @@ TclpGetCwd( } return NULL; } - if (Tcl_ExternalToUtfDStringEx(interp, NULL, buffer, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) { + if (Tcl_ExternalToUtfDStringEx(interp, NULL, buffer, TCL_INDEX_NONE, 0, + bufferPtr, NULL) != TCL_OK) { return NULL; } return Tcl_DStringValue(bufferPtr); @@ -843,7 +851,8 @@ TclpReadlink( const char *native; Tcl_DString ds; - if (Tcl_UtfToExternalDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, &ds, + NULL) != TCL_OK) { Tcl_DStringFree(&ds); return NULL; } @@ -855,7 +864,8 @@ TclpReadlink( return NULL; } - if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, length, 0, linkPtr, NULL) == TCL_OK) { + if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, length, 0, linkPtr, + NULL) == TCL_OK) { return Tcl_DStringValue(linkPtr); } #endif /* !DJGPP */ @@ -990,7 +1000,8 @@ TclpObjLink( return NULL; } target = TclGetStringFromObj(transPtr, &length); - if (Tcl_UtfToExternalDStringEx(NULL, NULL, target, length, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(NULL, NULL, target, length, 0, &ds, + NULL) != TCL_OK) { Tcl_DStringFree(&ds); return NULL; } @@ -1024,12 +1035,14 @@ TclpObjLink( } Tcl_DecrRefCount(transPtr); - length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link)); + length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, + sizeof(link)); if (length < 0) { return NULL; } - if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, 0, &ds, NULL) != TCL_OK) { + if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, 0, + &ds, NULL) != TCL_OK) { return NULL; } linkPtr = Tcl_DStringToObj(&ds); @@ -1096,7 +1109,8 @@ TclpNativeToNormalized( { Tcl_DString ds; - Tcl_ExternalToUtfDStringEx(NULL, NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); + Tcl_ExternalToUtfDStringEx(NULL, NULL, (const char *) clientData, + TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); return Tcl_DStringToObj(&ds); } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 81e3af5..ac743cc 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -54,21 +54,21 @@ static const char *const processors[NUMPROCESSORS] = { typedef struct { union { - unsigned int dwOemId; - struct { - int wProcessorArchitecture; - int wReserved; - }; + unsigned int dwOemId; + struct { + int wProcessorArchitecture; + int wReserved; + }; }; - unsigned int dwPageSize; + unsigned int dwPageSize; void *lpMinimumApplicationAddress; void *lpMaximumApplicationAddress; void *dwActiveProcessorMask; - unsigned int dwNumberOfProcessors; - unsigned int dwProcessorType; - unsigned int dwAllocationGranularity; - int wProcessorLevel; - int wProcessorRevision; + unsigned int dwNumberOfProcessors; + unsigned int dwProcessorType; + unsigned int dwAllocationGranularity; + int wProcessorLevel; + int wProcessorRevision; } SYSTEM_INFO; typedef struct { @@ -852,23 +852,25 @@ TclpSetVariables( #endif /* HAVE_COREFOUNDATION */ p = pkgPath; while ((q = strchr(p, ':')) != NULL) { - Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q-p)); - p = q+1; + Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q - p)); + p = q + 1; } if (*p) { Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, -1)); } - Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_pkgPath", -1), NULL, pkgListObj, TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_pkgPath", -1), NULL, + pkgListObj, TCL_GLOBAL_ONLY); { - /* Some platforms build configure scripts expect ~ expansion so do that */ - Tcl_Obj *origPaths; - Tcl_Obj *resolvedPaths; - - origPaths = Tcl_GetVar2Ex(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); - resolvedPaths = TclResolveTildePathList(origPaths); - if (resolvedPaths != origPaths && resolvedPaths != NULL) { - Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, resolvedPaths, TCL_GLOBAL_ONLY); - } + /* Some platforms build configure scripts expect ~ expansion so do that */ + Tcl_Obj *origPaths; + Tcl_Obj *resolvedPaths; + + origPaths = Tcl_GetVar2Ex(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); + resolvedPaths = TclResolveTildePathList(origPaths); + if (resolvedPaths != origPaths && resolvedPaths != NULL) { + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, resolvedPaths, + TCL_GLOBAL_ONLY); + } } #ifdef DJGPP @@ -897,7 +899,8 @@ TclpSetVariables( osInfo.dwMajorVersion = 11; } Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); - snprintf(buffer, sizeof(buffer), "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); + snprintf(buffer, sizeof(buffer), "%d.%d", + osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) { Tcl_SetVar2(interp, "tcl_platform", "machine", @@ -987,7 +990,7 @@ TclpSetVariables( * Define what the platform PATH separator is. [TIP #315] */ - Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ":", TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_platform", "pathSeparator", ":", TCL_GLOBAL_ONLY); } /* diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 939ec85..e0b8753 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -80,7 +80,7 @@ static int SetupStdFile(TclFile file, int type); static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -356,7 +356,7 @@ TclpCreatePipe( int TclpCloseFile( - TclFile file) /* The file to close. */ + TclFile file) /* The file to close. */ { int fd = GetFd(file); @@ -401,7 +401,7 @@ TclpCreateProcess( * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ - size_t argc, /* Number of arguments in following array. */ + size_t argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings in UTF-8. * argv[0] contains the name of the executable * translated using Tcl_TranslateFileName @@ -572,7 +572,7 @@ TclpCreateProcess( || !SetupStdFile(outputFile, TCL_STDOUT) || (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR)) || (joinThisError && - ((dup2(1,2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) { + ((dup2(1, 2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) { snprintf(errSpace, sizeof(errSpace), "%dforked process couldn't set up input/output", errno); len = strlen(errSpace); @@ -1003,7 +1003,7 @@ TclGetAndDetachPids( static int PipeBlockModeProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ @@ -1043,7 +1043,7 @@ PipeBlockModeProc( static int PipeClose2Proc( - void *instanceData, /* The pipe to close. */ + void *instanceData, /* The pipe to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { @@ -1140,7 +1140,7 @@ PipeClose2Proc( static int PipeInputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int toRead, /* How much space is available in the * buffer? */ @@ -1191,7 +1191,7 @@ PipeInputProc( static int PipeOutputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ @@ -1250,7 +1250,7 @@ PipeWatchNotifyChannelWrapper( static void PipeWatchProc( - void *instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1298,9 +1298,9 @@ PipeWatchProc( static int PipeGetHandleProc( - void *instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { PipeState *psPtr = (PipeState *)instanceData; diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 513ffdd..94af19b 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -236,7 +236,7 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode); #ifndef WIFSIGNALED # define WIFSIGNALED(stat) \ - (((*((int *) &(stat)))) && ((*((int *) &(stat))) \ + (((*((int *) &(stat)))) && ((*((int *) &(stat))) \ == ((*((int *) &(stat))) & 0x00FF))) #endif diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 78ed008..14be638 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -23,8 +23,8 @@ #define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ -#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1) -#define SOCK_TEMPLATE "sock%" TCL_Z_MODIFIER "x" +#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1) +#define SOCK_TEMPLATE "sock%" TCL_Z_MODIFIER "x" #undef SOCKET /* Possible conflict with win32 SOCKET */ @@ -64,8 +64,8 @@ struct TcpState { */ Tcl_TcpAcceptProc *acceptProc; - /* Proc to call on accept. */ - void *acceptProcData; /* The data for the accept proc. */ + /* Proc to call on accept. */ + void *acceptProcData; /* The data for the accept proc. */ /* * Only needed for client sockets @@ -75,10 +75,10 @@ struct TcpState { struct addrinfo *addr; /* Iterator over addrlist. */ struct addrinfo *myaddrlist;/* Local address. */ struct addrinfo *myaddr; /* Iterator over myaddrlist. */ - int filehandlers; /* Caches FileHandlers that get set up while - * an async socket is not yet connected. */ - int connectError; /* Cache SO_ERROR of async socket. */ - int cachedBlocking; /* Cache blocking mode of async socket. */ + int filehandlers; /* Caches FileHandlers that get set up while + * an async socket is not yet connected. */ + int connectError; /* Cache SO_ERROR of async socket. */ + int cachedBlocking; /* Cache blocking mode of async socket. */ }; /* @@ -156,7 +156,7 @@ static Tcl_FileProc WrapNotify; static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -195,7 +195,7 @@ printaddrinfo( getnameinfo(ai->ai_addr, ai->ai_addrlen, host, sizeof(host), port, sizeof(port), NI_NUMERICHOST|NI_NUMERICSERV); - fprintf(stderr,"%s: %s:%s\n", prefix, host, port); + fprintf(stderr, "%s: %s:%s\n", prefix, host, port); } } #endif @@ -227,7 +227,7 @@ InitializeHostName( memset(&u, (int) 0, sizeof(struct utsname)); if (uname(&u) >= 0) { /* INTL: Native. */ - hp = TclpGetHostByName(u.nodename); /* INTL: Native. */ + hp = TclpGetHostByName(u.nodename); /* INTL: Native. */ if (hp == NULL) { /* * Sometimes the nodename is fully qualified, but gets truncated @@ -246,11 +246,11 @@ InitializeHostName( Tcl_Free(node); } } - if (hp != NULL) { + if (hp != NULL) { native = hp->h_name; - } else { + } else { native = u.nodename; - } + } } #else /* !NO_UNAME */ /* @@ -357,7 +357,7 @@ TclpFinalizeSockets(void) static int TcpBlockModeProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ @@ -370,8 +370,8 @@ TcpBlockModeProc( SET_BITS(statePtr->flags, TCP_NONBLOCKING); } if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { - statePtr->cachedBlocking = mode; - return 0; + statePtr->cachedBlocking = mode; + return 0; } if (TclUnixSetBlockingMode(statePtr->fds.fd, mode) < 0) { return errno; @@ -443,37 +443,37 @@ WaitForConnect( */ if (GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE) - && !(errorCodePtr != NULL - && !GOT_BITS(statePtr->flags, TCP_NONBLOCKING))) { + && !(errorCodePtr != NULL + && !GOT_BITS(statePtr->flags, TCP_NONBLOCKING))) { *errorCodePtr = EWOULDBLOCK; return -1; } if (errorCodePtr == NULL || GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { - timeout = 0; + timeout = 0; } else { - timeout = -1; + timeout = -1; } do { - if (TclUnixWaitForFile(statePtr->fds.fd, - TCL_WRITABLE | TCL_EXCEPTION, timeout) != 0) { - TcpConnect(NULL, statePtr); - } - - /* - * Do this only once in the nonblocking case and repeat it until the - * socket is final when blocking. - */ + if (TclUnixWaitForFile(statePtr->fds.fd, + TCL_WRITABLE | TCL_EXCEPTION, timeout) != 0) { + TcpConnect(NULL, statePtr); + } + + /* + * Do this only once in the nonblocking case and repeat it until the + * socket is final when blocking. + */ } while (timeout == -1 && GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)); if (errorCodePtr != NULL) { - if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { - *errorCodePtr = EAGAIN; - return -1; - } else if (statePtr->connectError != 0) { - *errorCodePtr = ENOTCONN; - return -1; - } + if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { + *errorCodePtr = EAGAIN; + return -1; + } else if (statePtr->connectError != 0) { + *errorCodePtr = ENOTCONN; + return -1; + } } return 0; } @@ -502,7 +502,7 @@ WaitForConnect( static int TcpInputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -553,7 +553,7 @@ TcpInputProc( static int TcpOutputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ @@ -594,7 +594,7 @@ TcpOutputProc( static int TcpCloseProc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ TCL_UNUSED(Tcl_Interp *)) { TcpState *statePtr = (TcpState *)instanceData; @@ -627,10 +627,10 @@ TcpCloseProc( fds = next; } if (statePtr->addrlist != NULL) { - freeaddrinfo(statePtr->addrlist); + freeaddrinfo(statePtr->addrlist); } if (statePtr->myaddrlist != NULL) { - freeaddrinfo(statePtr->myaddrlist); + freeaddrinfo(statePtr->myaddrlist); } Tcl_Free(statePtr); return errorCode; @@ -655,7 +655,7 @@ TcpCloseProc( static int TcpClose2Proc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ TCL_UNUSED(Tcl_Interp *), int flags) /* Flags that indicate which side to close. */ { @@ -706,7 +706,7 @@ IPv6AddressNeedsNumericRendering( struct in6_addr addr) { if (IN6_ARE_ADDR_EQUAL(&addr, &in6addr_any)) { - return 1; + return 1; } /* @@ -715,11 +715,11 @@ IPv6AddressNeedsNumericRendering( */ if (!IN6_IS_ADDR_V4MAPPED(&addr)) { - return 0; + return 0; } return (addr.s6_addr[12] == 0 && addr.s6_addr[13] == 0 - && addr.s6_addr[14] == 0 && addr.s6_addr[15] == 0); + && addr.s6_addr[14] == 0 && addr.s6_addr[15] == 0); } #if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))) #pragma GCC diagnostic pop @@ -738,7 +738,7 @@ TcpHostPortList( int flags = 0; getnameinfo(&addr.sa, salen, nhost, sizeof(nhost), nport, sizeof(nport), - NI_NUMERICHOST | NI_NUMERICSERV); + NI_NUMERICHOST | NI_NUMERICSERV); Tcl_DStringAppendElement(dsPtr, nhost); /* @@ -747,14 +747,14 @@ TcpHostPortList( */ if (addr.sa.sa_family == AF_INET) { - if (addr.sa4.sin_addr.s_addr == INADDR_ANY) { - flags |= NI_NUMERICHOST; - } + if (addr.sa4.sin_addr.s_addr == INADDR_ANY) { + flags |= NI_NUMERICHOST; + } #ifndef NEED_FAKE_RFC2553 } else if (addr.sa.sa_family == AF_INET6) { - if (IPv6AddressNeedsNumericRendering(addr.sa6.sin6_addr)) { - flags |= NI_NUMERICHOST; - } + if (IPv6AddressNeedsNumericRendering(addr.sa6.sin6_addr)) { + flags |= NI_NUMERICHOST; + } #endif /* NEED_FAKE_RFC2553 */ } @@ -763,22 +763,22 @@ TcpHostPortList( */ if (interp != NULL && - Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { - flags |= NI_NUMERICHOST; + Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { + flags |= NI_NUMERICHOST; } if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0, - flags) == 0) { - /* - * Reverse mapping worked. - */ + flags) == 0) { + /* + * Reverse mapping worked. + */ - Tcl_DStringAppendElement(dsPtr, host); + Tcl_DStringAppendElement(dsPtr, host); } else { - /* - * Reverse mapping failed - use the numeric rep once more. - */ + /* + * Reverse mapping failed - use the numeric rep once more. + */ - Tcl_DStringAppendElement(dsPtr, nhost); + Tcl_DStringAppendElement(dsPtr, nhost); } Tcl_DStringAppendElement(dsPtr, nport); } @@ -907,25 +907,25 @@ TcpGetOptionProc( socklen_t optlen = sizeof(int); WaitForConnect(statePtr, NULL); - if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { - /* - * Suppress errors as long as we are not done. - */ - - errno = 0; - } else if (statePtr->connectError != 0) { - errno = statePtr->connectError; - statePtr->connectError = 0; - } else { - int err; - - getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &err, - &optlen); - errno = err; - } - if (errno != 0) { + if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { + /* + * Suppress errors as long as we are not done. + */ + + errno = 0; + } else if (statePtr->connectError != 0) { + errno = statePtr->connectError; + statePtr->connectError = 0; + } else { + int err; + + getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &err, + &optlen); + errno = err; + } + if (errno != 0) { Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errno), TCL_INDEX_NONE); - } + } return TCL_OK; } @@ -934,13 +934,13 @@ TcpGetOptionProc( WaitForConnect(statePtr, NULL); Tcl_DStringAppend(dsPtr, GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT) ? "1" : "0", TCL_INDEX_NONE); - return TCL_OK; + return TCL_OK; } if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && (strncmp(optionName, "-peername", len) == 0))) { - address peername; - socklen_t size = sizeof(peername); + address peername; + socklen_t size = sizeof(peername); WaitForConnect(statePtr, NULL); if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { @@ -963,11 +963,11 @@ TcpGetOptionProc( Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringStartSublist(dsPtr); } - TcpHostPortList(interp, dsPtr, peername, size); + TcpHostPortList(interp, dsPtr, peername, size); if (len) { - return TCL_OK; - } - Tcl_DStringEndSublist(dsPtr); + return TCL_OK; + } + Tcl_DStringEndSublist(dsPtr); } else { /* * getpeername failed - but if we were asked for all the options @@ -979,7 +979,7 @@ TcpGetOptionProc( if (len) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get peername: %s", + "can't get peername: %s", Tcl_PosixError(interp))); } return TCL_ERROR; @@ -1004,7 +1004,7 @@ TcpGetOptionProc( * In async connect output an empty string */ - found = 1; + found = 1; } else { for (fds = &statePtr->fds; fds != NULL; fds = fds->next) { size = sizeof(sockname); @@ -1014,16 +1014,16 @@ TcpGetOptionProc( } } } - if (found) { - if (len) { - return TCL_OK; - } - Tcl_DStringEndSublist(dsPtr); - } else { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get sockname: %s", Tcl_PosixError(interp))); - } + if (found) { + if (len) { + return TCL_OK; + } + Tcl_DStringEndSublist(dsPtr); + } else { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get sockname: %s", Tcl_PosixError(interp))); + } return TCL_ERROR; } } @@ -1070,7 +1070,7 @@ TcpGetOptionProc( if (len > 0) { return Tcl_BadChannelOption(interp, optionName, - "connecting keepalive nodelay peername sockname"); + "connecting keepalive nodelay peername sockname"); } return TCL_OK; @@ -1169,7 +1169,7 @@ WrapNotify( static void TcpWatchProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1177,24 +1177,23 @@ TcpWatchProc( TcpState *statePtr = (TcpState *)instanceData; if (statePtr->acceptProc != NULL) { - /* - * Make sure we don't mess with server sockets since they will never - * be readable or writable at the Tcl level. This keeps Tcl scripts - * from interfering with the -accept behavior (bug #3394732). - */ + /* + * Make sure we don't mess with server sockets since they will never + * be readable or writable at the Tcl level. This keeps Tcl scripts + * from interfering with the -accept behavior (bug #3394732). + */ return; } if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { - /* - * Async sockets use a FileHandler internally while connecting, so we - * need to cache this request until the connection has succeeded. - */ + /* + * Async sockets use a FileHandler internally while connecting, so we + * need to cache this request until the connection has succeeded. + */ - statePtr->filehandlers = mask; + statePtr->filehandlers = mask; } else if (mask) { - /* * Whether it is a bug or feature or otherwise, it is a fact of life * that on at least some Linux kernels select() fails to report that a @@ -1242,9 +1241,9 @@ TcpWatchProc( static int TcpGetHandleProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { TcpState *statePtr = (TcpState *)instanceData; @@ -1266,7 +1265,7 @@ TcpGetHandleProc( static void TcpAsyncCallback( - void *clientData, /* The socket state. */ + void *clientData, /* The socket state. */ TCL_UNUSED(int) /*mask*/) { TcpConnect(NULL, (TcpState *)clientData); @@ -1280,9 +1279,9 @@ TcpAsyncCallback( * This function opens a new socket in client mode. * * Results: - * TCL_OK, if the socket was successfully connected or an asynchronous - * connection is in progress. If an error occurs, TCL_ERROR is returned - * and an error message is left in interp. + * TCL_OK, if the socket was successfully connected or an asynchronous + * connection is in progress. If an error occurs, TCL_ERROR is returned + * and an error message is left in interp. * * Side effects: * Opens a socket. @@ -1314,14 +1313,14 @@ TcpConnect( static const int reuseaddr = 1; if (async_callback) { - goto reenter; + goto reenter; } for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL; - statePtr->addr = statePtr->addr->ai_next) { - for (statePtr->myaddr = statePtr->myaddrlist; - statePtr->myaddr != NULL; - statePtr->myaddr = statePtr->myaddr->ai_next) { + statePtr->addr = statePtr->addr->ai_next) { + for (statePtr->myaddr = statePtr->myaddrlist; + statePtr->myaddr != NULL; + statePtr->myaddr = statePtr->myaddr->ai_next) { /* * No need to try combinations of local and remote addresses of * different families. @@ -1331,19 +1330,19 @@ TcpConnect( continue; } - /* - * Close the socket if it is still open from the last unsuccessful - * iteration. - */ + /* + * Close the socket if it is still open from the last unsuccessful + * iteration. + */ - if (statePtr->fds.fd >= 0) { + if (statePtr->fds.fd >= 0) { close(statePtr->fds.fd); statePtr->fds.fd = -1; - errno = 0; + errno = 0; } statePtr->fds.fd = socket(statePtr->addr->ai_family, SOCK_STREAM, - 0); + 0); if (statePtr->fds.fd < 0) { continue; } @@ -1362,28 +1361,28 @@ TcpConnect( TclSockMinimumBuffers(INT2PTR(statePtr->fds.fd), SOCKET_BUFSIZE); if (async) { - ret = TclUnixSetBlockingMode(statePtr->fds.fd, - TCL_MODE_NONBLOCKING); - if (ret < 0) { - continue; - } - } - - /* - * Must reset the error variable here, before we use it for the - * first time in this iteration. - */ - - error = 0; - - (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR, - (char *) &reuseaddr, sizeof(reuseaddr)); - ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr, - statePtr->myaddr->ai_addrlen); - if (ret < 0) { - error = errno; - continue; - } + ret = TclUnixSetBlockingMode(statePtr->fds.fd, + TCL_MODE_NONBLOCKING); + if (ret < 0) { + continue; + } + } + + /* + * Must reset the error variable here, before we use it for the + * first time in this iteration. + */ + + error = 0; + + (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR, + (char *) &reuseaddr, sizeof(reuseaddr)); + ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr, + statePtr->myaddr->ai_addrlen); + if (ret < 0) { + error = errno; + continue; + } /* * Attempt to connect. The connect may fail at present with an @@ -1393,35 +1392,35 @@ TcpConnect( */ ret = connect(statePtr->fds.fd, statePtr->addr->ai_addr, - statePtr->addr->ai_addrlen); - if (ret < 0) { - error = errno; - } + statePtr->addr->ai_addrlen); + if (ret < 0) { + error = errno; + } if (ret < 0 && errno == EINPROGRESS) { - Tcl_CreateFileHandler(statePtr->fds.fd, - TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback, - statePtr); - errno = EWOULDBLOCK; - SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); - return TCL_OK; - - reenter: - CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); - Tcl_DeleteFileHandler(statePtr->fds.fd); - - /* - * Read the error state from the socket to see if the async - * connection has succeeded or failed. As this clears the - * error condition, we cache the status in the socket state - * struct for later retrieval by [fconfigure -error]. - */ - - optlen = sizeof(int); - - getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, - (char *) &error, &optlen); - errno = error; - } + Tcl_CreateFileHandler(statePtr->fds.fd, + TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback, + statePtr); + errno = EWOULDBLOCK; + SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); + return TCL_OK; + + reenter: + CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); + Tcl_DeleteFileHandler(statePtr->fds.fd); + + /* + * Read the error state from the socket to see if the async + * connection has succeeded or failed. As this clears the + * error condition, we cache the status in the socket state + * struct for later retrieval by [fconfigure -error]. + */ + + optlen = sizeof(int); + + getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, + (char *) &error, &optlen); + errno = error; + } if (error == 0) { goto out; } @@ -1432,43 +1431,43 @@ TcpConnect( statePtr->connectError = error; CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); if (async_callback) { - /* - * An asynchonous connection has finally succeeded or failed. - */ - - TcpWatchProc(statePtr, statePtr->filehandlers); - TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking); - - if (error != 0) { - SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); - } - - /* - * We need to forward the writable event that brought us here, because - * upon reading of getsockopt(SO_ERROR), at least some OSes clear the - * writable state from the socket, and so a subsequent select() on - * behalf of a script level [fileevent] would not fire. It doesn't - * hurt that this is also called in the successful case and will save - * the event mechanism one roundtrip through select(). - */ + /* + * An asynchonous connection has finally succeeded or failed. + */ + + TcpWatchProc(statePtr, statePtr->filehandlers); + TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking); + + if (error != 0) { + SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); + } + + /* + * We need to forward the writable event that brought us here, because + * upon reading of getsockopt(SO_ERROR), at least some OSes clear the + * writable state from the socket, and so a subsequent select() on + * behalf of a script level [fileevent] would not fire. It doesn't + * hurt that this is also called in the successful case and will save + * the event mechanism one roundtrip through select(). + */ if (statePtr->cachedBlocking == TCL_MODE_NONBLOCKING) { Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE); } } if (error != 0) { - /* - * Failure for either a synchronous connection, or an async one that - * failed before it could enter background mode, e.g. because an - * invalid -myaddr was given. - */ - - if (interp != NULL) { - errno = error; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", Tcl_PosixError(interp))); - } - return TCL_ERROR; + /* + * Failure for either a synchronous connection, or an async one that + * failed before it could enter background mode, e.g. because an + * invalid -myaddr was given. + */ + + if (interp != NULL) { + errno = error; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open socket: %s", Tcl_PosixError(interp))); + } + return TCL_ERROR; } return TCL_OK; } @@ -1511,16 +1510,16 @@ Tcl_OpenTcpClient( */ if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg) - || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, - &errorMsg)) { - if (addrlist != NULL) { - freeaddrinfo(addrlist); - } - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", errorMsg)); - } - return NULL; + || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, + &errorMsg)) { + if (addrlist != NULL) { + freeaddrinfo(addrlist); + } + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open socket: %s", errorMsg)); + } + return NULL; } /* @@ -1540,14 +1539,14 @@ Tcl_OpenTcpClient( */ if (TcpConnect(interp, statePtr) != TCL_OK) { - TcpCloseProc(statePtr, NULL); - return NULL; + TcpCloseProc(statePtr, NULL); + return NULL; } snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, PTR2INT(statePtr)); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - statePtr, TCL_READABLE | TCL_WRITABLE); + statePtr, TCL_READABLE | TCL_WRITABLE); if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation", "auto crlf") == TCL_ERROR) { Tcl_CloseEx(NULL, statePtr->channel, 0); @@ -1574,10 +1573,10 @@ Tcl_OpenTcpClient( Tcl_Channel Tcl_MakeTcpClientChannel( - void *sock) /* The socket to wrap up into a channel. */ + void *sock) /* The socket to wrap up into a channel. */ { return (Tcl_Channel) TclpMakeTcpClientChannelMode(sock, - TCL_READABLE | TCL_WRITABLE); + TCL_READABLE | TCL_WRITABLE); } /* @@ -1599,7 +1598,7 @@ Tcl_MakeTcpClientChannel( void * TclpMakeTcpClientChannelMode( - void *sock, /* The socket to wrap up into a channel. */ + void *sock, /* The socket to wrap up into a channel. */ int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { @@ -1646,7 +1645,7 @@ Tcl_OpenTcpServerEx( const char *service, /* Port number to open. */ const char *myHost, /* Name of local host. */ unsigned int flags, /* Flags. */ - int backlog, /* Length of OS listen backlog queue. */ + int backlog, /* Length of OS listen backlog queue. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ @@ -1684,17 +1683,17 @@ Tcl_OpenTcpServerEx( repeat: if (retry > 0) { - if (statePtr != NULL) { - TcpCloseProc(statePtr, NULL); - statePtr = NULL; - } - if (addrlist != NULL) { - freeaddrinfo(addrlist); - addrlist = NULL; - } - if (retry >= MAXRETRY) { - goto error; - } + if (statePtr != NULL) { + TcpCloseProc(statePtr, NULL); + statePtr = NULL; + } + if (addrlist != NULL) { + freeaddrinfo(addrlist); + addrlist = NULL; + } + if (retry >= MAXRETRY) { + goto error; + } } retry++; chosenport = 0; @@ -1705,14 +1704,14 @@ Tcl_OpenTcpServerEx( } if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, - &errorMsg)) { + &errorMsg)) { my_errno = errno; goto error; } for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) { sock = socket(addrPtr->ai_family, addrPtr->ai_socktype, - addrPtr->ai_protocol); + addrPtr->ai_protocol); if (sock == -1) { if (howfar < SOCKET) { howfar = SOCKET; @@ -1760,100 +1759,101 @@ Tcl_OpenTcpServerEx( #endif } - /* - * Make sure we use the same port number when opening two server - * sockets for IPv4 and IPv6 on a random port. - * - * As sockaddr_in6 uses the same offset and size for the port member - * as sockaddr_in, we can handle both through the IPv4 API. - */ + /* + * Make sure we use the same port number when opening two server + * sockets for IPv4 and IPv6 on a random port. + * + * As sockaddr_in6 uses the same offset and size for the port member + * as sockaddr_in, we can handle both through the IPv4 API. + */ if (port == 0 && chosenport != 0) { ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port = - htons(chosenport); + htons(chosenport); } #ifdef IPV6_V6ONLY /* - * Missing on: Solaris 2.8 - */ + * Missing on: Solaris 2.8 + */ - if (addrPtr->ai_family == AF_INET6) { - int v6only = 1; + if (addrPtr->ai_family == AF_INET6) { + int v6only = 1; - (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY, - &v6only, sizeof(v6only)); - } + (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY, + &v6only, sizeof(v6only)); + } #endif /* IPV6_V6ONLY */ status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen); - if (status == -1) { + if (status == -1) { if (howfar < BIND) { howfar = BIND; my_errno = errno; } - close(sock); - sock = -1; - if (port == 0 && errno == EADDRINUSE) { - goto repeat; - } - continue; - } - if (port == 0 && chosenport == 0) { - address sockname; - socklen_t namelen = sizeof(sockname); - - /* - * Synchronize port numbers when binding to port 0 of multiple - * addresses. - */ - - if (getsockname(sock, &sockname.sa, &namelen) >= 0) { - chosenport = ntohs(sockname.sa4.sin_port); - } - } - if (backlog < 0) { - backlog = SOMAXCONN; - } - status = listen(sock, backlog); - if (status < 0) { + close(sock); + sock = -1; + if (port == 0 && errno == EADDRINUSE) { + goto repeat; + } + continue; + } + if (port == 0 && chosenport == 0) { + address sockname; + socklen_t namelen = sizeof(sockname); + + /* + * Synchronize port numbers when binding to port 0 of multiple + * addresses. + */ + + if (getsockname(sock, &sockname.sa, &namelen) >= 0) { + chosenport = ntohs(sockname.sa4.sin_port); + } + } + if (backlog < 0) { + backlog = SOMAXCONN; + } + status = listen(sock, backlog); + if (status < 0) { if (howfar < LISTEN) { howfar = LISTEN; my_errno = errno; } - close(sock); - sock = -1; - if (port == 0 && errno == EADDRINUSE) { - goto repeat; - } - continue; - } - if (statePtr == NULL) { - /* - * Allocate a new TcpState for this socket. - */ - - statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); - memset(statePtr, 0, sizeof(TcpState)); - statePtr->acceptProc = acceptProc; - statePtr->acceptProcData = acceptProcData; - snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, PTR2INT(statePtr)); - newfds = &statePtr->fds; - } else { - newfds = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); - memset(newfds, (int) 0, sizeof(TcpFdList)); - fds->next = newfds; - } - newfds->fd = sock; - newfds->statePtr = statePtr; - fds = newfds; - - /* - * Set up the callback mechanism for accepting connections from new - * clients. - */ - - Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds); + close(sock); + sock = -1; + if (port == 0 && errno == EADDRINUSE) { + goto repeat; + } + continue; + } + if (statePtr == NULL) { + /* + * Allocate a new TcpState for this socket. + */ + + statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); + memset(statePtr, 0, sizeof(TcpState)); + statePtr->acceptProc = acceptProc; + statePtr->acceptProcData = acceptProcData; + snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, + PTR2INT(statePtr)); + newfds = &statePtr->fds; + } else { + newfds = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); + memset(newfds, (int) 0, sizeof(TcpFdList)); + fds->next = newfds; + } + newfds->fd = sock; + newfds->statePtr = statePtr; + fds = newfds; + + /* + * Set up the callback mechanism for accepting connections from new + * clients. + */ + + Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds); } error: @@ -1866,15 +1866,15 @@ Tcl_OpenTcpServerEx( return statePtr->channel; } if (interp != NULL) { - Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", TCL_INDEX_NONE); + Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", TCL_INDEX_NONE); if (errorMsg == NULL) { - errno = my_errno; - Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), TCL_INDEX_NONE); - } else { + errno = my_errno; + Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), TCL_INDEX_NONE); + } else { Tcl_AppendToObj(errorObj, errorMsg, TCL_INDEX_NONE); } - Tcl_SetObjResult(interp, errorObj); + Tcl_SetObjResult(interp, errorObj); } if (sock != -1) { close(sock); @@ -1900,7 +1900,7 @@ Tcl_OpenTcpServerEx( static void TcpAccept( - void *data, /* Callback token. */ + void *data, /* Callback token. */ TCL_UNUSED(int) /*mask*/) { TcpFdList *fds = (TcpFdList *)data; /* Client data of server socket. */ @@ -1938,9 +1938,9 @@ TcpAccept( if (fds->statePtr->acceptProc != NULL) { getnameinfo(&addr.sa, len, host, sizeof(host), port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); + NI_NUMERICHOST|NI_NUMERICSERV); fds->statePtr->acceptProc(fds->statePtr->acceptProcData, - newSockState->channel, host, atoi(port)); + newSockState->channel, host, atoi(port)); } } diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 24bc72d..da39a96 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -213,8 +213,8 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ - void *clientData, /* The one argument to Main() */ - size_t stackSize, /* Size of stack for the new thread */ + void *clientData, /* The one argument to Main() */ + size_t stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c index 8ca2c5f..6d4e3c9 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -33,7 +33,7 @@ typedef struct FileHandler { XtInputId except; /* Xt exception callback handle. */ Tcl_FileProc *proc; /* Procedure to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -263,7 +263,7 @@ NotifierExitHandler( static void SetTimer( - const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ + const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { unsigned long timeout; @@ -339,7 +339,7 @@ CreateFileHandler( * called. */ Tcl_FileProc *proc, /* Procedure to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { FileHandler *filePtr; @@ -627,7 +627,7 @@ FileHandlerEventProc( static int WaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { int timeout; diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 01fa6c3..1d83976 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -432,8 +432,8 @@ TclWinDriveLetterForVolMountPoint( int TclWinCPUID( - int index, /* Which CPUID value to retrieve. */ - int *regsPtr) /* Registers after the CPUID. */ + int index, /* Which CPUID value to retrieve. */ + int *regsPtr) /* Registers after the CPUID. */ { int status = TCL_ERROR; diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 4c08464..75beedd 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -384,7 +384,7 @@ FileEventProc( static int FileBlockProc( - void *instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -423,7 +423,7 @@ FileBlockProc( static int FileCloseProc( - void *instanceData, /* Pointer to FileInfo structure. */ + void *instanceData, /* Pointer to FileInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -473,7 +473,7 @@ FileCloseProc( * pointer on the thread local list. */ - FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE); + FileThreadActionProc(fileInfoPtr, TCL_CHANNEL_THREAD_REMOVE); break; } } @@ -501,7 +501,7 @@ FileCloseProc( static long long FileWideSeekProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ @@ -553,7 +553,7 @@ FileWideSeekProc( static int FileTruncateProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ long long length) /* Length to truncate at. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -629,7 +629,7 @@ FileTruncateProc( static int FileInputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ char *buf, /* Where to store data read. */ int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ @@ -684,7 +684,7 @@ FileInputProc( static int FileOutputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -731,7 +731,7 @@ FileOutputProc( static void FileWatchProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ int mask) /* What events to watch for; OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -770,9 +770,9 @@ FileWatchProc( static int FileGetHandleProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -891,7 +891,8 @@ StatOpenFile( */ TclNewObj(dictObj); -#define STORE_ELEM(name, value) StoreElementInDict(dictObj, name, value) +#define STORE_ELEM(name, value) \ + StoreElementInDict(dictObj, name, value) STORE_ELEM("dev", Tcl_NewWideIntObj((long) dev)); STORE_ELEM("ino", Tcl_NewWideIntObj((long long) inode)); @@ -920,7 +921,7 @@ StatOpenFile( static int FileGetOptionProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ Tcl_Interp *interp, /* For error reporting. */ const char *optionName, /* What option to read, or NULL for all. */ Tcl_DString *dsPtr) /* Where to write the value read. */ @@ -1218,7 +1219,7 @@ TclpOpenFileChannel( Tcl_Channel Tcl_MakeFileChannel( - void *rawHandle, /* OS level handle */ + void *rawHandle, /* OS level handle */ int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { @@ -1466,8 +1467,8 @@ TclpGetDefaultStdChannel( * Set up the normal channel options for stdio handles. */ - if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK || - Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) { + if (Tcl_SetChannelOption(NULL, channel, "-translation", "auto")!=TCL_OK || + Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode)!=TCL_OK) { Tcl_CloseEx(NULL, channel, 0); return (Tcl_Channel) NULL; } @@ -1687,7 +1688,7 @@ FileGetType( return type; } - /* +/* *---------------------------------------------------------------------- * * NativeIsComPort -- diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 8b289b1..e655195 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -94,10 +94,10 @@ static int gInitialized = 0; * and bufPtr[0]:bufPtr[length - (size-start)]. */ typedef struct RingBuffer { - char *bufPtr; /* Pointer to buffer storage */ - Tcl_Size capacity; /* Size of the buffer in RingBufferChar */ - Tcl_Size start; /* Start of the data within the buffer. */ - Tcl_Size length; /* Number of RingBufferChar*/ + char *bufPtr; /* Pointer to buffer storage */ + Tcl_Size capacity; /* Size of the buffer in RingBufferChar */ + Tcl_Size start; /* Start of the data within the buffer. */ + Tcl_Size length; /* Number of RingBufferChar*/ } RingBuffer; #define RingBufferLength(ringPtr_) ((ringPtr_)->length) #define RingBufferHasFreeSpace(ringPtr_) ((ringPtr_)->length < (ringPtr_)->capacity) @@ -125,25 +125,28 @@ typedef struct RingBuffer { * from gConsoleHandleInfoList. */ typedef struct ConsoleHandleInfo { - struct ConsoleHandleInfo *nextPtr; /* Process-global list of consoles */ - HANDLE console; /* Console handle */ - HANDLE consoleThread; /* Handle to thread doing actual i/o on the console */ - SRWLOCK lock; /* Controls access to this structure. - * Cheaper than CRITICAL_SECTION but note does not - * support recursive locks or Try* style attempts.*/ + struct ConsoleHandleInfo *nextPtr; + /* Process-global list of consoles */ + HANDLE console; /* Console handle */ + HANDLE consoleThread; /* Handle to thread doing actual i/o on the + * console */ + SRWLOCK lock; /* Controls access to this structure. + * Cheaper than CRITICAL_SECTION but note does + * not support recursive locks or Try* style + * attempts.*/ CONDITION_VARIABLE consoleThreadCV;/* For awakening console thread */ CONDITION_VARIABLE interpThreadCV; /* For awakening interpthread(s) */ - RingBuffer buffer; /* Buffer for data transferred between console - * threads and Tcl threads. For input consoles, - * written by the console thread and read by Tcl - * threads. The converse for output threads */ - DWORD initMode; /* Initial console mode. */ - DWORD lastError; /* An error caused by the last background - * operation. Set to 0 if no error has been - * detected. */ - int numRefs; /* See comments above */ - int permissions; /* TCL_READABLE for input consoles, TCL_WRITABLE - * for output. Only one or the other can be set. */ + RingBuffer buffer; /* Buffer for data transferred between console + * threads and Tcl threads. For input consoles, + * written by the console thread and read by Tcl + * threads. The converse for output threads */ + DWORD initMode; /* Initial console mode. */ + DWORD lastError; /* An error caused by the last background + * operation. Set to 0 if no error has been + * detected. */ + int numRefs; /* See comments above */ + int permissions; /* TCL_READABLE for input consoles, TCL_WRITABLE + * for output. Only one or the other can be set. */ int flags; #define CONSOLE_DATA_AWAITED 0x0001 /* An interpreter is awaiting data */ } ConsoleHandleInfo; @@ -183,7 +186,7 @@ typedef struct ConsoleChannelInfo { Tcl_Channel channel; /* Pointer to channel structure. */ DWORD initMode; /* Initial console mode. */ int numRefs; /* See comments above */ - int permissions; /* OR'ed combination of TCL_READABLE, + int permissions; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which operations are valid on the file. */ int watchMask; /* OR'ed combination of TCL_READABLE, @@ -298,23 +301,23 @@ static ConsoleChannelInfo *gWatchingChannelList; */ static const Tcl_ChannelType consoleChannelType = { - "console", /* Type name. */ - TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ - ConsoleInputProc, /* Input proc. */ - ConsoleOutputProc, /* Output proc. */ - NULL, /* Seek proc. */ - ConsoleSetOptionProc, /* Set option proc. */ - ConsoleGetOptionProc, /* Get option proc. */ - ConsoleWatchProc, /* Set up notifier to watch the channel. */ - ConsoleGetHandleProc, /* Get an OS handle from channel. */ - ConsoleCloseProc, /* close2proc. */ - ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ - NULL, /* Flush proc. */ - NULL, /* Handler proc. */ - NULL, /* Wide seek proc. */ - ConsoleThreadActionProc, /* Thread action proc. */ - NULL /* Truncation proc. */ + "console", /* Type name. */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ + NULL, /* Old close proc. Deprecated */ + ConsoleInputProc, /* Input proc. */ + ConsoleOutputProc, /* Output proc. */ + NULL, /* Seek proc. Not seekable. Deprecated */ + ConsoleSetOptionProc, /* Set option proc. */ + ConsoleGetOptionProc, /* Get option proc. */ + ConsoleWatchProc, /* Set up notifier to watch the channel. */ + ConsoleGetHandleProc, /* Get an OS handle from channel. */ + ConsoleCloseProc, /* New close2 proc. */ + ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ + NULL, /* Flush proc. */ + NULL, /* Handler proc. */ + NULL, /* Wide seek proc. Not seekable */ + ConsoleThreadActionProc, /* Thread action proc. */ + NULL /* Truncation proc. */ }; /* @@ -754,8 +757,8 @@ NudgeWatchers( * * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an * event. It walks the channel list and if any input channel has data - * available or output channel has space for data, sets the event loop - * blocking time to 0 so that it will poll immediately. + * available or output channel has space for data, sets the event loop + * blocking time to 0 so that it will poll immediately. * * Results: * None. @@ -1999,13 +2002,13 @@ ConsoleWriterThread( */ static ConsoleHandleInfo * AllocateConsoleHandleInfo( - HANDLE consoleHandle, - int permissions) /* TCL_READABLE or TCL_WRITABLE */ + HANDLE consoleHandle, /* Actual handle to console. */ + int permissions) /* TCL_READABLE or TCL_WRITABLE */ { ConsoleHandleInfo *handleInfoPtr; DWORD consoleMode; - handleInfoPtr = (ConsoleHandleInfo *)Tcl_Alloc(sizeof(*handleInfoPtr)); + handleInfoPtr = (ConsoleHandleInfo *) Tcl_Alloc(sizeof(*handleInfoPtr)); memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); handleInfoPtr->console = consoleHandle; InitializeSRWLock(&handleInfoPtr->lock); @@ -2023,12 +2026,14 @@ AllocateConsoleHandleInfo( SetConsoleMode(consoleHandle, consoleMode); } handleInfoPtr->consoleThread = CreateThread( - NULL, /* default security descriptor */ - 2*CONSOLE_BUFFER_SIZE, /* Stack size - gets rounded up to granularity */ - permissions == TCL_READABLE ? ConsoleReaderThread : ConsoleWriterThread, - handleInfoPtr, /* Pass to thread */ - 0, /* Flags - no special cases */ - NULL); /* Don't care about thread id */ + NULL, /* default security descriptor */ + 2 * CONSOLE_BUFFER_SIZE, /* Stack size, rounded up to granularity */ + permissions == TCL_READABLE + ? ConsoleReaderThread + : ConsoleWriterThread, + handleInfoPtr, /* Pass to thread */ + 0, /* Flags - no special cases */ + NULL); /* Don't care about thread id */ if (handleInfoPtr->consoleThread == NULL) { /* Note - SRWLock and condition variables do not need finalization */ RingBufferClear(&handleInfoPtr->buffer); @@ -2257,7 +2262,7 @@ ConsoleThreadActionProc( */ static int ConsoleSetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ @@ -2346,7 +2351,7 @@ ConsoleSetOptionProc( static int ConsoleGetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ diff --git a/win/tclWinDde.c b/win/tclWinDde.c index f36407d..86fde1a 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -92,8 +92,10 @@ TCL_DECLARE_MUTEX(ddeMutex) #if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) +# define Tcl_WCharToUtfDString(a, b, c) \ + Tcl_WinTCharToUtf((TCHAR *)(a), (b) * sizeof(WCHAR), c) +# define Tcl_UtfToWCharDString(a, b, c) \ + (WCHAR *)Tcl_WinUtfToTChar(a, b, c) # else # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString @@ -310,10 +312,10 @@ Initialize(void) static const WCHAR * DdeSetServerName( Tcl_Interp *interp, - const WCHAR *name, /* The name that will be used to refer to the + const WCHAR *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ - int flags, /* DDE_FLAG_FORCE or 0 */ + int flags, /* DDE_FLAG_FORCE or 0 */ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { @@ -515,7 +517,7 @@ DdeGetRegistrationPtr( static void DeleteProc( - void *clientData) /* The interp we are deleting. */ + void *clientData) /* The interp we are deleting. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; RegisteredInterp *searchPtr, *prevPtr; @@ -1303,9 +1305,9 @@ SetDdeError( static int DdeObjCmd( - void *dummy, /* Not used. */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* The interp we are sending from */ - Tcl_Size objc, /* Number of arguments */ + Tcl_Size objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { static const char *const ddeCommands[] = { @@ -1324,7 +1326,7 @@ DdeObjCmd( "-async", "-binary", NULL }; enum DdeExecOptions { - DDE_EXEC_ASYNC, DDE_EXEC_BINARY + DDE_EXEC_ASYNC, DDE_EXEC_BINARY }; static const char *const ddeEvalOptions[] = { "-async", NULL diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 0af484d..b6db893 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -904,8 +904,8 @@ TclpObjCopyDirectory( Tcl_Obj *normSrcPtr, *normDestPtr; int ret; - normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr); - normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr); + normSrcPtr = Tcl_FSGetNormalizedPath(NULL, srcPathPtr); + normDestPtr = Tcl_FSGetNormalizedPath(NULL, destPathPtr); if ((normSrcPtr == NULL) || (normDestPtr == NULL)) { return TCL_ERROR; } @@ -1711,8 +1711,8 @@ ConvertFileNameFormat( Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp); Tcl_DStringFree(&ds); - tempPath = Tcl_DStringToObj(&dsTemp); - Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); + tempPath = Tcl_DStringToObj(&dsTemp); + Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); FindClose(handle); } } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 17f4898..2f43ed2 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -497,7 +497,8 @@ TclWinSymLinkDelete( if (hFile != INVALID_HANDLE_VALUE) { if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, - REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) { + REPARSE_MOUNTPOINT_HEADER_SIZE, NULL, 0, &returnedLength, + NULL)) { /* * Error setting junction. */ @@ -583,7 +584,7 @@ WinReadLinkDirectory( */ if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer, - L"\\??\\Volume{",11) == 0) { + L"\\??\\Volume{", 11) == 0) { char drive; /* @@ -606,7 +607,7 @@ WinReadLinkDirectory( }; driveSpec[0] = drive; - retVal = Tcl_NewStringObj(driveSpec,2); + retVal = Tcl_NewStringObj(driveSpec, 2); Tcl_IncrRefCount(retVal); return retVal; } @@ -623,14 +624,14 @@ WinReadLinkDirectory( goto invalidError; } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer - .PathBuffer, L"\\\\?\\",4) == 0) { + .PathBuffer, L"\\\\?\\", 4) == 0) { /* * Strip off the prefix. */ offset = 4; } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer - .PathBuffer, L"\\??\\",4) == 0) { + .PathBuffer, L"\\??\\", 4) == 0) { /* * Strip off the prefix. */ @@ -645,9 +646,9 @@ WinReadLinkDirectory( reparseBuffer->MountPointReparseBuffer .SubstituteNameLength>>1, &ds); - copy = Tcl_DStringValue(&ds)+offset; - len = Tcl_DStringLength(&ds)-offset; - retVal = Tcl_NewStringObj(copy,len); + copy = Tcl_DStringValue(&ds) + offset; + len = Tcl_DStringLength(&ds) - offset; + retVal = Tcl_NewStringObj(copy, len); Tcl_IncrRefCount(retVal); Tcl_DStringFree(&ds); return retVal; @@ -1438,23 +1439,23 @@ TclpGetUserHome( if (domain == NULL) { const char *ptr; - /* - * Treat the current user as a special case because the general case - * below does not properly retrieve the path. The NetUserGetInfo - * call returns an empty path and the code defaults to the user's - * name in the profiles directory. On modern Windows systems, this - * is generally wrong as when the account is a Microsoft account, - * for example abcdefghi@outlook.com, the directory name is - * abcde and not abcdefghi. - * - * Note we could have just used env(USERPROFILE) here but - * the intent is to retrieve (as on Unix) the system's view - * of the home irrespective of environment settings of HOME - * and USERPROFILE. - * - * Fixing this for the general user needs more investigating but - * at least for the current user we can use a direct call. - */ + /* + * Treat the current user as a special case because the general case + * below does not properly retrieve the path. The NetUserGetInfo + * call returns an empty path and the code defaults to the user's + * name in the profiles directory. On modern Windows systems, this + * is generally wrong as when the account is a Microsoft account, + * for example abcdefghi@outlook.com, the directory name is + * abcde and not abcdefghi. + * + * Note we could have just used env(USERPROFILE) here but + * the intent is to retrieve (as on Unix) the system's view + * of the home irrespective of environment settings of HOME + * and USERPROFILE. + * + * Fixing this for the general user needs more investigating but + * at least for the current user we can use a direct call. + */ ptr = TclpGetUserName(&ds); if (ptr != NULL && strcasecmp(name, ptr) == 0) { HANDLE hProcess; @@ -1749,8 +1750,8 @@ NativeAccess( * go). */ - if(!GetSecurityDescriptorOwner(sdPtr,&pSid,&SidDefaulted) || - memcmp(GetSidIdentifierAuthority(pSid),&samba_unmapped, + if(!GetSecurityDescriptorOwner(sdPtr, &pSid, &SidDefaulted) || + memcmp(GetSidIdentifierAuthority(pSid), &samba_unmapped, sizeof(SID_IDENTIFIER_AUTHORITY))==0) { HeapFree(GetProcessHeap(), 0, sdPtr); return 0; /* Attrib tests say access allowed. */ @@ -1893,7 +1894,7 @@ NativeIsExec( int TclpObjChdir( - Tcl_Obj *pathPtr) /* Path to new working directory. */ + Tcl_Obj *pathPtr) /* Path to new working directory. */ { int result; const WCHAR *nativePath; @@ -2053,28 +2054,28 @@ NativeStat( if (fileHandle != INVALID_HANDLE_VALUE) { BY_HANDLE_FILE_INFORMATION data; - if (GetFileInformationByHandle(fileHandle,&data) != TRUE) { - fileType = GetFileType(fileHandle); - CloseHandle(fileHandle); - if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) { - Tcl_SetErrno(ENOENT); - return -1; - } + if (GetFileInformationByHandle(fileHandle, &data) != TRUE) { + fileType = GetFileType(fileHandle); + CloseHandle(fileHandle); + if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) { + Tcl_SetErrno(ENOENT); + return -1; + } - /* + /* * Mock up the expected structure */ - memset(&data, 0, sizeof(data)); - statPtr->st_atime = 0; - statPtr->st_mtime = 0; - statPtr->st_ctime = 0; - } else { - CloseHandle(fileHandle); - statPtr->st_atime = ToCTime(data.ftLastAccessTime); - statPtr->st_mtime = ToCTime(data.ftLastWriteTime); - statPtr->st_ctime = ToCTime(data.ftCreationTime); - } + memset(&data, 0, sizeof(data)); + statPtr->st_atime = 0; + statPtr->st_mtime = 0; + statPtr->st_ctime = 0; + } else { + CloseHandle(fileHandle); + statPtr->st_atime = ToCTime(data.ftLastAccessTime); + statPtr->st_mtime = ToCTime(data.ftLastWriteTime); + statPtr->st_ctime = ToCTime(data.ftCreationTime); + } attr = data.dwFileAttributes; statPtr->st_size = ((long long) data.nFileSizeLow) | (((long long) data.nFileSizeHigh) << 32); @@ -2134,11 +2135,11 @@ NativeStat( dev = NativeDev(nativePath); mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath)); if (fileType == FILE_TYPE_CHAR) { - mode &= ~S_IFMT; - mode |= S_IFCHR; + mode &= ~S_IFMT; + mode |= S_IFCHR; } else if (fileType == FILE_TYPE_DISK) { - mode &= ~S_IFMT; - mode |= S_IFBLK; + mode &= ~S_IFMT; + mode |= S_IFBLK; } statPtr->st_dev = (dev_t) dev; @@ -2520,9 +2521,9 @@ TclpFilesystemPathType( int TclpObjNormalizePath( TCL_UNUSED(Tcl_Interp *), - Tcl_Obj *pathPtr, /* An unshared object containing the path to + Tcl_Obj *pathPtr, /* An unshared object containing the path to * normalize */ - int nextCheckpoint) /* offset to start at in pathPtr */ + int nextCheckpoint) /* offset to start at in pathPtr */ { char *lastValidPathEnd = NULL; Tcl_DString dsNorm; /* This will hold the normalized string. */ @@ -2870,7 +2871,7 @@ TclWinVolumeRelativeNormalize( const char *drive = TclGetString(useThisCwd); - absolutePath = Tcl_NewStringObj(drive,2); + absolutePath = Tcl_NewStringObj(drive, 2); Tcl_AppendToObj(absolutePath, path, TCL_INDEX_NONE); Tcl_IncrRefCount(absolutePath); @@ -2972,10 +2973,10 @@ TclpNativeToNormalized( */ if (*copy == '\\') { - if (0 == strncmp(copy,"\\??\\",4)) { + if (0 == strncmp(copy, "\\??\\", 4)) { copy += 4; len -= 4; - } else if (0 == strncmp(copy,"\\\\?\\",4)) { + } else if (0 == strncmp(copy, "\\\\?\\", 4)) { copy += 4; len -= 4; } @@ -2991,7 +2992,7 @@ TclpNativeToNormalized( } } - objPtr = Tcl_NewStringObj(copy,len); + objPtr = Tcl_NewStringObj(copy, len); Tcl_DStringFree(&ds); return objPtr; @@ -3257,8 +3258,8 @@ TclpUtime( * TclWinFileOwned -- * * Returns 1 if the specified file exists and is owned by the current - * user and 0 otherwise. Like the Unix case, the check is made using - * the real process SID, not the effective (impersonation) one. + * user and 0 otherwise. Like the Unix case, the check is made using + * the real process SID, not the effective (impersonation) one. * *--------------------------------------------------------------------------- */ @@ -3280,12 +3281,12 @@ TclWinFileOwned( if (GetNamedSecurityInfoW((LPWSTR) native, SE_FILE_OBJECT, OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL, &secd) != ERROR_SUCCESS) { - /* + /* * Either not a file, or we do not have access to it in which case we * are in all likelihood not the owner. */ - return 0; + return 0; } /* @@ -3296,19 +3297,19 @@ TclWinFileOwned( */ if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) { - /* + /* * Find out how big the buffer needs to be. */ - bufsz = 0; - GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); - if (bufsz) { - buf = (LPBYTE)Tcl_Alloc(bufsz); - if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { - owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); - } - } - CloseHandle(token); + bufsz = 0; + GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); + if (bufsz) { + buf = (LPBYTE)Tcl_Alloc(bufsz); + if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { + owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); + } + } + CloseHandle(token); } /* @@ -3316,13 +3317,13 @@ TclWinFileOwned( */ if (secd) { - LocalFree(secd); /* Also frees ownerSid */ + LocalFree(secd); /* Also frees ownerSid */ } if (buf) { - Tcl_Free(buf); + Tcl_Free(buf); } - return (owned != 0); /* Convert non-0 to 1 */ + return (owned != 0); /* Convert non-0 to 1 */ } /* diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 4234ceb..ac26a81 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -516,14 +516,14 @@ TclpSetVariables( Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); } else { - /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ - ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); - if (ptr != NULL && ptr[0]) { - Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); - } else { - /* Last resort */ - Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); - } + /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ + ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); + if (ptr != NULL && ptr[0]) { + Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); + } else { + /* Last resort */ + Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); + } } } @@ -542,7 +542,7 @@ TclpSetVariables( * Define what the platform PATH separator is. [TIP #315] */ - Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_platform", "pathSeparator", ";", TCL_GLOBAL_ONLY); } /* @@ -570,7 +570,7 @@ Tcl_Size TclpFindVariable( const char *name, /* Name of desired environment variable * (UTF-8). */ - Tcl_Size *lengthPtr) /* Used to return length of name (for + Tcl_Size *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 9995602..4456d53 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -51,7 +51,7 @@ MODULE_SCOPE int TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal, const WCHAR *LinkCopy); MODULE_SCOPE int TclWinSymLinkDelete(const WCHAR *LinkOriginal, int linkOnly); -MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); +MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); MODULE_SCOPE void TclWinGenerateChannelName(char channelName[], const char *channelTypeName, void *channelImpl); MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr); diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 1cc7ae1..d406c7f 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -90,11 +90,11 @@ TclpDlopen( Tcl_DString ds; - /* - * Remember the first error on load attempt to be used if the - * second load attempt below also fails. - */ - firstError = (nativeName == NULL) ? + /* + * Remember the first error on load attempt to be used if the + * second load attempt below also fails. + */ + firstError = (nativeName == NULL) ? ERROR_MOD_NOT_FOUND : GetLastError(); Tcl_DStringInit(&ds); @@ -106,19 +106,19 @@ TclpDlopen( if (hInstance == NULL) { DWORD lastError; - Tcl_Obj *errMsg; - - /* - * We choose to only use the error from the second call if the first - * call failed due to the file not being found. Else stick to the - * first error for reporting purposes. - */ - if (firstError == ERROR_MOD_NOT_FOUND || + Tcl_Obj *errMsg; + + /* + * We choose to only use the error from the second call if the first + * call failed due to the file not being found. Else stick to the + * first error for reporting purposes. + */ + if (firstError == ERROR_MOD_NOT_FOUND || firstError == ERROR_DLL_NOT_FOUND) { - lastError = GetLastError(); - } else { - lastError = firstError; - } + lastError = GetLastError(); + } else { + lastError = firstError; + } errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", TclGetString(pathPtr)); @@ -157,11 +157,11 @@ TclpDlopen( Tcl_AppendToObj(errMsg, "the library initialization" " routine failed", TCL_INDEX_NONE); break; - case ERROR_BAD_EXE_FORMAT: + case ERROR_BAD_EXE_FORMAT: Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", (char *)NULL); Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", TCL_INDEX_NONE); - break; - default: + break; + default: Tcl_WinConvertError(lastError); Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), TCL_INDEX_NONE); } diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 2c93a41..dbeea14 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -148,7 +148,7 @@ TclpInitNotifier(void) void TclpFinalizeNotifier( - void *clientData) /* Pointer to notifier data. */ + void *clientData) /* Pointer to notifier data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -218,7 +218,7 @@ TclpFinalizeNotifier( void TclpAlertNotifier( - void *clientData) /* Pointer to thread data. */ + void *clientData) /* Pointer to thread data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -264,7 +264,7 @@ TclpAlertNotifier( void TclpSetTimer( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); UINT timeout; @@ -370,9 +370,9 @@ int TclAsyncNotifier( TCL_UNUSED(int), /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(void *), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ TCL_UNUSED(int *), /* Flag to mark. */ - TCL_UNUSED(int)) /* Value of mark. */ + TCL_UNUSED(int)) /* Value of mark. */ { return 0; } @@ -464,7 +464,7 @@ TclpNotifierData(void) int TclpWaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); MSG msg; diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index dbf3324..1f80e7a 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -203,7 +203,7 @@ static void PipeThreadActionProc(void *instanceData, static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -916,7 +916,7 @@ TclpCreateProcess( * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ - size_t argc, /* Number of arguments in following array. */ + size_t argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings. argv[0] contains * the name of the executable converted to * native format (using the @@ -1540,7 +1540,7 @@ static void BuildCommandLine( const char *executable, /* Full path of executable (including * extension). Replacement for argv[0]. */ - size_t argc, /* Number of arguments. */ + size_t argc, /* Number of arguments. */ const char **argv, /* Argument strings in UTF. */ Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the * command line (WCHAR). */ @@ -1957,7 +1957,7 @@ TclGetAndDetachPids( static int PipeBlockModeProc( - void *instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -1996,7 +1996,7 @@ PipeBlockModeProc( static int PipeClose2Proc( - void *instanceData, /* Pointer to PipeInfo structure. */ + void *instanceData, /* Pointer to PipeInfo structure. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { @@ -2167,7 +2167,7 @@ PipeClose2Proc( static int PipeInputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -2261,7 +2261,7 @@ PipeInputProc( static int PipeOutputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -2409,7 +2409,7 @@ PipeEventProc( mask = TCL_WRITABLE; } - if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr,0) >= 0)) { + if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr, 0) >= 0)) { if (infoPtr->readFlags & PIPE_EOF) { mask = TCL_READABLE; } else { @@ -2443,7 +2443,7 @@ PipeEventProc( static void PipeWatchProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -2505,9 +2505,9 @@ PipeWatchProc( static int PipeGetHandleProc( - void *instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr; diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 8ab4548..d426e7d 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -512,12 +512,12 @@ typedef DWORD_PTR * PDWORD_PTR; * use by tclAlloc.c. */ -#define TclpSysAlloc(size) ((void*)HeapAlloc(GetProcessHeap(), \ - 0, size)) -#define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \ - 0, (HGLOBAL)ptr)) -#define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \ - 0, (LPVOID)ptr, size)) +#define TclpSysAlloc(size) \ + ((void*)HeapAlloc(GetProcessHeap(), 0, size)) +#define TclpSysFree(ptr) \ + (HeapFree(GetProcessHeap(), 0, (HGLOBAL)ptr)) +#define TclpSysRealloc(ptr, size) \ + ((void*)HeapReAlloc(GetProcessHeap(), 0, (LPVOID)ptr, size)) /* This type is not defined in the Windows headers */ #define socklen_t int diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 68e22cb..fc495ed 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -88,8 +88,10 @@ static DWORD lastType = REG_RESOURCE_LIST; #if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) +# define Tcl_WCharToUtfDString(a, b, c) \ + Tcl_WinTCharToUtf((TCHAR *)(a), (b) * sizeof(WCHAR), c) +# define Tcl_UtfToWCharDString(a, b, c) \ + (WCHAR *)Tcl_WinUtfToTChar(a, b, c) # else # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString @@ -293,9 +295,9 @@ DeleteCmd( static int RegistryObjCmd( - void *dummy, /* Not used. */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Size n = 1, argc; @@ -935,7 +937,7 @@ GetValueNames( */ size = MAX_KEY_LENGTH; - while (RegEnumValueW(key,index, (WCHAR *)Tcl_DStringValue(&buffer), + while (RegEnumValueW(key, index, (WCHAR *)Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { Tcl_DStringInit(&ds); Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&buffer), size, &ds); @@ -1429,7 +1431,7 @@ SetValue( static int BroadcastValue( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { LRESULT result; diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index e27937e..66a1540 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -204,7 +204,7 @@ static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf, static const Tcl_ChannelType serialChannelType = { "serial", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ SerialInputProc, /* Input proc. */ SerialOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -218,7 +218,7 @@ static const Tcl_ChannelType serialChannelType = { NULL, /* handler proc. */ NULL, /* wide seek proc */ SerialThreadActionProc, /* thread action proc */ - NULL /* truncate */ + NULL /* truncate */ }; /* @@ -854,7 +854,7 @@ SerialBlockingWrite( static int SerialInputProc( - void *instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -961,7 +961,7 @@ SerialInputProc( static int SerialOutputProc( - void *instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -1191,7 +1191,7 @@ SerialEventProc( static void SerialWatchProc( - void *instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1248,9 +1248,9 @@ SerialWatchProc( static int SerialGetHandleProc( - void *instanceData, /* The serial state. */ + void *instanceData, /* The serial state. */ TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; @@ -1610,7 +1610,7 @@ SerialModemStatusStr( static int SerialSetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ @@ -2034,7 +2034,7 @@ SerialSetOptionProc( static int SerialGetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 49f445d..c11413c 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1289,7 +1289,7 @@ TcpGetOptionProc( int reverseDNS = 0; #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" #define HAVE_OPTION(option) \ - ((len > 1) && (optionName[1] == option[1]) && \ + ((len > 1) && (optionName[1] == option[1]) && \ (strncmp(optionName, option, len) == 0)) /* @@ -2655,7 +2655,7 @@ SocketEventProc( */ SetEvent(tsdPtr->socketListLock); - WaitForConnect(statePtr,NULL); + WaitForConnect(statePtr, NULL); } else { /* * No async connect reenter pending. Just clear event. diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index d5c582b..dee606b 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -218,8 +218,8 @@ TclpThreadCreate( EnterCriticalSection(&joinLock); - *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and - * on WIN64 sizeof void* != sizeof unsigned */ + *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and + * on WIN64 sizeof void* != sizeof unsigned */ #if defined(_MSC_VER) || defined(__MSVCRT__) tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize, -- cgit v0.12 From 4cc3928cafac6e7bafba5226ba43d418aa42e666 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 13 May 2024 16:39:30 +0000 Subject: clock.test: amend to hotfix [9889f96f4da77e3b] - ensemble created implicitely now --- tests/clock.test | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index ef41ad5..0144512 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -273,6 +273,8 @@ proc ::testClock::registry { cmd path key } { # Base test cases: +# no lazy creation of clock-ensemble (interim, bug [9889f96f4da77e3b], [31fd84270644f67d]), +# so ensemble created implicitely in init.tcl test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" -setup { set i [interp create]; # because clock can be used somewhere, test it in new interp: } -body { @@ -286,7 +288,7 @@ test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" -setup { } } -cleanup { interp delete $i -} -result {ens:0 ens:1 stubs:0 stubs:1} +} -result {ens:1 ens:1 stubs:0 stubs:1} test clock-0.1a "initial: safe interpreter shares clock command with parent" -setup { set i [interp create] $i eval {set sci [interp create -safe]} @@ -301,7 +303,7 @@ test clock-0.1a "initial: safe interpreter shares clock command with parent" -se } } -cleanup { interp delete $i -} -result {ens:0 ens:1 stubs:0 stubs:1} +} -result {ens:1 ens:1 stubs:0 stubs:1} test clock-0.2 "initial: loading of format/locale does not overwrite interp state (errorInfo)" -setup { # be sure - we have no cached locale/msgcat, etc: -- cgit v0.12 From d787ca78217dc43f79b0cdd843f6b7e04b19410d Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 13 May 2024 16:48:30 +0000 Subject: silence warning (implicit-fallthrough) --- generic/tclExecute.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index ccbd953..79bfb11 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -7451,11 +7451,13 @@ TEBCresume( break; default: Tcl_Panic("clockRead instruction with unknown clock#"); + break; } TclNewIntObj(objResultPtr, wval); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(2, 0, 1); } + break; default: Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc); -- cgit v0.12 From fce7223c2cdcec792e2053c1e0a4c442331fc776 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 14 May 2024 08:26:06 +0000 Subject: Backout the "dullest commit ever" (not my words ....). It breaks the build. JN: Many of those changes are actually good, but there are too many changes to be able to search for a bug somewhere. Feel free to re-apply, after assuring it's really only whitespace changes. (my advise: do that after 9.0b2) --- generic/tcl.h | 11 +- generic/tclAlloc.c | 6 +- generic/tclArithSeries.c | 74 +++--- generic/tclAssembly.c | 21 +- generic/tclAsync.c | 14 +- generic/tclBasic.c | 51 ++-- generic/tclBinary.c | 45 ++-- generic/tclCkalloc.c | 40 +-- generic/tclClock.c | 37 ++- generic/tclClockFmt.c | 33 ++- generic/tclCmdAH.c | 49 ++-- generic/tclCmdIL.c | 223 +++++++++------- generic/tclCmdMZ.c | 14 +- generic/tclCompCmds.c | 83 +++--- generic/tclCompCmdsGR.c | 7 +- generic/tclCompCmdsSZ.c | 125 +++++---- generic/tclCompExpr.c | 6 +- generic/tclCompile.c | 51 ++-- generic/tclCompile.h | 10 +- generic/tclConfig.c | 2 +- generic/tclDate.h | 69 +++-- generic/tclDictObj.c | 44 +-- generic/tclDisassemble.c | 118 ++++---- generic/tclEncoding.c | 159 ++++++----- generic/tclEnsemble.c | 224 ++++++++-------- generic/tclEnv.c | 15 +- generic/tclEvent.c | 33 +-- generic/tclFCmd.c | 10 +- generic/tclFileName.c | 110 ++++---- generic/tclHash.c | 62 ++--- generic/tclIO.c | 101 +++---- generic/tclIO.h | 11 +- generic/tclIOCmd.c | 10 +- generic/tclIOGT.c | 14 +- generic/tclIORChan.c | 108 ++++---- generic/tclIORTrans.c | 82 +++--- generic/tclIOSock.c | 4 +- generic/tclIOUtil.c | 34 +-- generic/tclIndexObj.c | 40 +-- generic/tclInt.h | 184 +++++++------ generic/tclInterp.c | 88 +++--- generic/tclLink.c | 42 +-- generic/tclListObj.c | 335 +++++++++++------------ generic/tclLiteral.c | 36 +-- generic/tclLoad.c | 9 +- generic/tclMain.c | 4 +- generic/tclNamesp.c | 43 +-- generic/tclNotify.c | 16 +- generic/tclOO.c | 42 +-- generic/tclOOBasic.c | 2 +- generic/tclOOCall.c | 15 +- generic/tclOODefineCmds.c | 4 +- generic/tclOOInt.h | 65 +++-- generic/tclOOMethod.c | 12 +- generic/tclObj.c | 363 +++++++++++++------------ generic/tclParse.c | 30 +-- generic/tclPathObj.c | 130 ++++----- generic/tclPipe.c | 2 +- generic/tclPkg.c | 46 ++-- generic/tclPosixStr.c | 6 +- generic/tclPreserve.c | 13 +- generic/tclProc.c | 16 +- generic/tclProcess.c | 2 +- generic/tclRegexp.c | 10 +- generic/tclResult.c | 112 ++++---- generic/tclScan.c | 22 +- generic/tclStrToD.c | 70 ++--- generic/tclStringObj.c | 83 +++--- generic/tclStubCall.c | 9 +- generic/tclStubInit.c | 112 ++------ generic/tclStubLib.c | 3 +- generic/tclThread.c | 6 +- generic/tclThreadAlloc.c | 8 +- generic/tclThreadStorage.c | 2 +- generic/tclTimer.c | 50 ++-- generic/tclTrace.c | 89 +++---- generic/tclUtf.c | 97 ++++--- generic/tclUtil.c | 412 ++++++++++++++-------------- generic/tclVar.c | 143 +++++----- generic/tclZipfs.c | 41 ++- generic/tclZlib.c | 2 +- macosx/tclMacOSXFCmd.c | 12 +- macosx/tclMacOSXNotify.c | 8 +- unix/tclAppInit.c | 2 +- unix/tclEpollNotfy.c | 43 +-- unix/tclKqueueNotfy.c | 6 +- unix/tclLoadDyld.c | 4 +- unix/tclLoadNext.c | 6 +- unix/tclLoadOSF.c | 2 +- unix/tclSelectNotfy.c | 6 +- unix/tclUnixChan.c | 38 +-- unix/tclUnixCompat.c | 116 ++++---- unix/tclUnixFCmd.c | 22 +- unix/tclUnixFile.c | 60 ++--- unix/tclUnixInit.c | 53 ++-- unix/tclUnixPipe.c | 22 +- unix/tclUnixPort.h | 2 +- unix/tclUnixSock.c | 650 ++++++++++++++++++++++----------------------- unix/tclUnixThrd.c | 4 +- unix/tclXtNotify.c | 8 +- win/tclWin32Dll.c | 4 +- win/tclWinChan.c | 33 ++- win/tclWinConsole.c | 109 ++++---- win/tclWinDde.c | 18 +- win/tclWinFCmd.c | 8 +- win/tclWinFile.c | 147 +++++----- win/tclWinInit.c | 20 +- win/tclWinInt.h | 2 +- win/tclWinLoad.c | 40 +-- win/tclWinNotify.c | 12 +- win/tclWinPipe.c | 22 +- win/tclWinPort.h | 12 +- win/tclWinReg.c | 14 +- win/tclWinSerial.c | 18 +- win/tclWinSock.c | 4 +- win/tclWinThrd.c | 4 +- 116 files changed, 3137 insertions(+), 3320 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index c475799..947e4a7 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1965,7 +1965,8 @@ typedef struct Tcl_EncodingType { Tcl_EncodingConvertProc *fromUtfProc; /* Function to convert from UTF-8 into * external encoding. */ - Tcl_FreeProc *freeProc; /* If non-NULL, function to call when this + Tcl_FreeProc *freeProc; + /* If non-NULL, function to call when this * encoding is deleted. */ void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ @@ -2454,9 +2455,9 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); # define attemptckalloc Tcl_AttemptAlloc # ifdef _MSC_VER /* Silence invalid C4090 warnings */ -# define ckfree(a) Tcl_Free((void *)(a)) -# define ckrealloc(a, b) Tcl_Realloc((void *)(a), (b)) -# define attemptckrealloc(a, b) Tcl_AttemptRealloc((void *)(a), (b)) +# define ckfree(a) Tcl_Free((void *)(a)) +# define ckrealloc(a,b) Tcl_Realloc((void *)(a),(b)) +# define attemptckrealloc(a,b) Tcl_AttemptRealloc((void *)(a),(b)) # else # define ckfree Tcl_Free # define ckrealloc Tcl_Realloc @@ -2477,7 +2478,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); # undef Tcl_DumpActiveMemory # define Tcl_DumpActiveMemory(x) # undef Tcl_ValidateAllMemory -# define Tcl_ValidateAllMemory(x, y) +# define Tcl_ValidateAllMemory(x,y) #endif /* !TCL_MEM_DEBUG */ diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index 9a7dcba..b52d1b3 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -305,7 +305,7 @@ TclpAlloc( #endif Tcl_MutexUnlock(allocMutexPtr); - return (void *)(overPtr + 1); + return (void *)(overPtr+1); } /* @@ -581,7 +581,7 @@ TclpRealloc( #endif Tcl_MutexUnlock(allocMutexPtr); - return (void *)(overPtr + 1); + return (void *)(overPtr+1); } maxSize = (size_t)1 << (i+3); expensive = 0; @@ -695,7 +695,7 @@ mstats( #undef TclpAlloc void * TclpAlloc( - size_t numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { return malloc(numBytes); } diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 1f15395..fd1014c 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -97,11 +97,11 @@ static int TclArithSeriesObjStep(Tcl_Obj *arithSeriesObj, /* ------------------------ ArithSeries object type -------------------------- */ static const Tcl_ObjType arithSeriesType = { - "arithseries", /* name */ - FreeArithSeriesInternalRep, /* freeIntRepProc */ - DupArithSeriesInternalRep, /* dupIntRepProc */ - UpdateStringOfArithSeries, /* updateStringProc */ - SetArithSeriesFromAny, /* setFromAnyProc */ + "arithseries", /* name */ + FreeArithSeriesInternalRep, /* freeIntRepProc */ + DupArithSeriesInternalRep, /* dupIntRepProc */ + UpdateStringOfArithSeries, /* updateStringProc */ + SetArithSeriesFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V2( ArithSeriesObjLength, TclArithSeriesObjIndex, @@ -231,19 +231,21 @@ maxPrecision( * * ArithSeriesLen -- * - * Compute the length of the equivalent list where every element is - * generated starting from *start*, and adding *step* to generate every - * successive element that's < *end* for positive steps, or > *end* for - * negative steps. + * Compute the length of the equivalent list where + * every element is generated starting from *start*, + * and adding *step* to generate every successive element + * that's < *end* for positive steps, or > *end* for negative + * steps. * * Results: * - * The length of the list generated by the given range, that may be zero. - * The function returns -1 if the list is of length infinite. + * The length of the list generated by the given range, + * that may be zero. + * The function returns -1 if the list is of length infinite. * * Side effects: * - * None. + * None. * *---------------------------------------------------------------------- */ @@ -495,13 +497,13 @@ NewArithSeriesDbl( * assignNumber -- * * Create the appropriate Tcl_Obj value for the given numeric values. - * Used locally only for decoding [lseq] numeric arguments. + * Used locally only for decoding [lseq] numeric arguments. * refcount = 0. * * Results: * * A Tcl_Obj pointer. - * No assignment on error. + * No assignment on error. * * Side Effects: * @@ -544,7 +546,7 @@ assignNumber( * * Creates a new ArithSeries object. Some arguments may be NULL and will * be computed based on the other given arguments. - * refcount = 0. + * refcount = 0. * * Results: * @@ -559,14 +561,14 @@ assignNumber( int TclNewArithSeriesObj( - Tcl_Interp *interp, /* For error reporting */ - Tcl_Obj **arithSeriesObj, /* return value */ - int useDoubles, /* Flag indicates values start, - * end, step, are treated as doubles */ - Tcl_Obj *startObj, /* Starting value */ - Tcl_Obj *endObj, /* Ending limit */ - Tcl_Obj *stepObj, /* increment value */ - Tcl_Obj *lenObj) /* Number of elements */ + Tcl_Interp *interp, /* For error reporting */ + Tcl_Obj **arithSeriesObj, /* return value */ + int useDoubles, /* Flag indicates values start, + ** end, step, are treated as doubles */ + Tcl_Obj *startObj, /* Starting value */ + Tcl_Obj *endObj, /* Ending limit */ + Tcl_Obj *stepObj, /* increment value */ + Tcl_Obj *lenObj) /* Number of elements */ { double dstart, dend, dstep; Tcl_WideInt start, end, step; @@ -779,8 +781,8 @@ TclArithSeriesObjStep( static int SetArithSeriesFromAny( - TCL_UNUSED(Tcl_Interp *), /* Used for error reporting if not NULL. */ - TCL_UNUSED(Tcl_Obj *)) /* The object to convert. */ + TCL_UNUSED(Tcl_Interp *), /* Used for error reporting if not NULL. */ + TCL_UNUSED(Tcl_Obj *)) /* The object to convert. */ { Tcl_Panic("SetArithSeriesFromAny: should never be called"); return TCL_ERROR; @@ -792,11 +794,11 @@ SetArithSeriesFromAny( * TclArithSeriesObjRange -- * * Makes a slice of an ArithSeries value. - * *arithSeriesObj must be known to be a valid list. + * *arithSeriesObj must be known to be a valid list. * * Results: * Returns a pointer to the sliced series. - * This may be a new object or the same object if not shared. + * This may be a new object or the same object if not shared. * * Side effects: * ?The possible conversion of the object referenced by listPtr? @@ -807,11 +809,11 @@ SetArithSeriesFromAny( int TclArithSeriesObjRange( - Tcl_Interp *interp, /* For error message(s) */ + Tcl_Interp *interp, /* For error message(s) */ Tcl_Obj *arithSeriesObj, /* List object to take a range from. */ Tcl_Size fromIdx, /* Index of first element to include. */ Tcl_Size toIdx, /* Index of last element to include. */ - Tcl_Obj **newObjPtr) /* return value */ + Tcl_Obj **newObjPtr) /* return value */ { ArithSeries *arithSeriesRepPtr; Tcl_Obj *startObj, *endObj, *stepObj; @@ -1005,16 +1007,16 @@ TclArithSeriesGetElements( * values appropriately swapped and the Step value sign is changed. * * Results: - * The result will be an ArithSeries in the reverse order. + * The result will be an ArithSeries in the reverse order. * * Side effects: - * The ogiginal obj will be modified and returned if it is not Shared. + * The ogiginal obj will be modified and returned if it is not Shared. * *---------------------------------------------------------------------- */ int TclArithSeriesObjReverse( - Tcl_Interp *interp, /* For error message(s) */ + Tcl_Interp *interp, /* For error message(s) */ Tcl_Obj *arithSeriesObj, /* List object to reverse. */ Tcl_Obj **newObjPtr) { @@ -1151,7 +1153,7 @@ UpdateStringOfArithSeries( char tmp[TCL_DOUBLE_SPACE + 2]; tmp[0] = 0; - Tcl_PrintDouble(NULL, d, tmp); + Tcl_PrintDouble(NULL,d,tmp); if ((bytlen + strlen(tmp)) > TCL_SIZE_MAX) { break; // overflow } @@ -1189,14 +1191,14 @@ UpdateStringOfArithSeries( * * Evaluate the "in" operation for expr * - * This can be done more efficiently in the Arith Series relative to - * doing a linear search as implemented in expr. + * This can be done more efficiently in the Arith Series relative to + * doing a linear search as implemented in expr. * * Results: * Boolean true or false (1/0) * * Side effects: - * None + * None * *---------------------------------------------------------------------- */ diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 76f60fc..7bec144 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -222,9 +222,9 @@ typedef struct AssemblyEnv { Tcl_HashTable labelHash; /* Hash table whose keys are labels and whose * values are 'label' objects storing the code * offsets of the labels. */ - Tcl_Size cmdLine; /* Current line number within the assembly + Tcl_Size cmdLine; /* Current line number within the assembly * code */ - Tcl_Size* clNext; /* Invisible continuation line for + Tcl_Size* clNext; /* Invisible continuation line for * [info frame] */ BasicBlock* head_bb; /* First basic block in the code */ BasicBlock* curr_bb; /* Current basic block */ @@ -322,10 +322,10 @@ static Tcl_DupInternalRepProc DupAssembleCodeInternalRep; static const Tcl_ObjType assembleCodeType = { "assemblecode", - FreeAssembleCodeInternalRep, - DupAssembleCodeInternalRep, - NULL, /* updateStringProc */ - NULL, /* setFromAnyProc */ + FreeAssembleCodeInternalRep, /* freeIntRepProc */ + DupAssembleCodeInternalRep, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; @@ -851,7 +851,8 @@ CompileAssembleObj( Interp *iPtr = (Interp *) interp; /* Internals of the interpreter */ CompileEnv compEnv; /* Compilation environment structure */ - ByteCode *codePtr = NULL; /* Bytecode resulting from the assembly */ + 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 */ @@ -1270,7 +1271,7 @@ AssembleOneLine( Tcl_Size operand1Len; /* String length of the operand */ int opnd; /* Integer representation of an operand */ int litIndex; /* Literal pool index of a constant */ - Tcl_Size localVar; /* LVT index of a local variable */ + Tcl_Size localVar; /* LVT index of a local variable */ int flags; /* Flags for a basic block */ JumptableInfo* jtPtr; /* Pointer to a jumptable */ int infoIndex; /* Index of the jumptable in auxdata */ @@ -1967,7 +1968,7 @@ CreateMirrorJumpTable( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Obj* jumps) /* List of alternating keywords and labels */ { - Tcl_Size objc; /* Number of elements in the 'jumps' list */ + Tcl_Size objc; /* Number of elements in the 'jumps' list */ Tcl_Obj** objv; /* Pointers to the elements in the list */ CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -3824,7 +3825,7 @@ ProcessCatchesInBasicBlock( */ if (bbPtr->flags & BB_JUMPTABLE) { - for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable, &jtSearch); + for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch); result == TCL_OK && jtEntry != NULL; jtEntry = Tcl_NextHashEntry(&jtSearch)) { targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry); diff --git a/generic/tclAsync.c b/generic/tclAsync.c index e6144b2..f0f0c9c 100644 --- a/generic/tclAsync.c +++ b/generic/tclAsync.c @@ -30,7 +30,7 @@ typedef struct AsyncHandler { * for the process. */ Tcl_AsyncProc *proc; /* Procedure to call when handler is * invoked. */ - void *clientData; /* Value to pass to handler when it is + void *clientData; /* Value to pass to handler when it is * invoked. */ struct ThreadSpecificData *originTsd; /* Used in Tcl_AsyncMark to modify thread- @@ -38,7 +38,7 @@ typedef struct AsyncHandler { * associated to. */ Tcl_ThreadId originThrdId; /* Origin thread where this token was created * and where it will be yielded. */ - void *notifierData; /* Platform notifier data or NULL. */ + void *notifierData; /* Platform notifier data or NULL. */ } AsyncHandler; typedef struct ThreadSpecificData { @@ -142,7 +142,7 @@ Tcl_AsyncHandler Tcl_AsyncCreate( Tcl_AsyncProc *proc, /* Procedure to call when handler is * invoked. */ - void *clientData) /* Argument to pass to handler. */ + void *clientData) /* Argument to pass to handler. */ { AsyncHandler *asyncPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -190,7 +190,7 @@ Tcl_AsyncCreate( void Tcl_AsyncMark( - Tcl_AsyncHandler async) /* Token for handler. */ + Tcl_AsyncHandler async) /* Token for handler. */ { AsyncHandler *token = (AsyncHandler *) async; @@ -224,8 +224,8 @@ Tcl_AsyncMark( int Tcl_AsyncMarkFromSignal( - Tcl_AsyncHandler async, /* Token for handler. */ - int sigNumber) /* Signal number. */ + Tcl_AsyncHandler async, /* Token for handler. */ + int sigNumber) /* Signal number. */ { #if TCL_THREADS AsyncHandler *token = (AsyncHandler *) async; @@ -378,7 +378,7 @@ Tcl_AsyncInvoke( void Tcl_AsyncDelete( - Tcl_AsyncHandler async) /* Token for handler to delete. */ + Tcl_AsyncHandler async) /* Token for handler to delete. */ { AsyncHandler *asyncPtr = (AsyncHandler *) async; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b017e78..3940d4b 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -151,21 +151,17 @@ TCL_DECLARE_MUTEX(commandTypeLock); * are used to save the evaluation state between NR calls to each coro. */ -#define SAVE_CONTEXT(context) \ - do { \ - (context).framePtr = iPtr->framePtr; \ - (context).varFramePtr = iPtr->varFramePtr; \ - (context).cmdFramePtr = iPtr->cmdFramePtr; \ - (context).lineLABCPtr = iPtr->lineLABCPtr; \ - } while (0) - -#define RESTORE_CONTEXT(context) \ - do { \ - iPtr->framePtr = (context).framePtr; \ - iPtr->varFramePtr = (context).varFramePtr; \ - iPtr->cmdFramePtr = (context).cmdFramePtr; \ - iPtr->lineLABCPtr = (context).lineLABCPtr; \ - } while (0) +#define SAVE_CONTEXT(context) \ + (context).framePtr = iPtr->framePtr; \ + (context).varFramePtr = iPtr->varFramePtr; \ + (context).cmdFramePtr = iPtr->cmdFramePtr; \ + (context).lineLABCPtr = iPtr->lineLABCPtr + +#define RESTORE_CONTEXT(context) \ + iPtr->framePtr = (context).framePtr; \ + iPtr->varFramePtr = (context).varFramePtr; \ + iPtr->cmdFramePtr = (context).cmdFramePtr; \ + iPtr->lineLABCPtr = (context).lineLABCPtr /* * Static functions in this file: @@ -811,8 +807,8 @@ Tcl_CreateInterp(void) if (sizeof(time_t) != 8) { Tcl_Panic(" is not compatible with VS2005+"); } - if ((offsetof(Tcl_StatBuf, st_atime) != 32) - || (offsetof(Tcl_StatBuf, st_ctime) != 48)) { + if ((offsetof(Tcl_StatBuf,st_atime) != 32) + || (offsetof(Tcl_StatBuf,st_ctime) != 48)) { Tcl_Panic(" is not compatible with VS2005+"); } #endif @@ -895,11 +891,11 @@ Tcl_CreateInterp(void) iPtr->errorStack = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(iPtr->errorStack); iPtr->resetErrorStack = 1; - TclNewLiteralStringObj(iPtr->upLiteral, "UP"); + TclNewLiteralStringObj(iPtr->upLiteral,"UP"); Tcl_IncrRefCount(iPtr->upLiteral); - TclNewLiteralStringObj(iPtr->callLiteral, "CALL"); + TclNewLiteralStringObj(iPtr->callLiteral,"CALL"); Tcl_IncrRefCount(iPtr->callLiteral); - TclNewLiteralStringObj(iPtr->innerLiteral, "INNER"); + TclNewLiteralStringObj(iPtr->innerLiteral,"INNER"); Tcl_IncrRefCount(iPtr->innerLiteral); iPtr->innerContext = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(iPtr->innerContext); @@ -1198,7 +1194,7 @@ Tcl_CreateInterp(void) * Register the builtin math functions. */ - nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL, NULL); + nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL); if (nsPtr == NULL) { Tcl_Panic("Can't create math function namespace"); } @@ -3678,7 +3674,7 @@ Tcl_DeleteCommandFromToken( CommandTrace *tracePtr; /* CallCommandTraces() does not cmdPtr, that's * done just before Tcl_DeleteCommandFromToken() returns */ - CallCommandTraces(iPtr, cmdPtr, NULL, NULL, TCL_TRACE_DELETE); + CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); /* * Now delete these traces. @@ -4600,8 +4596,7 @@ Dispatch( } if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) { Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr); - const char *a[6]; - Tcl_Size i[2]; + const char *a[6]; Tcl_Size i[2]; TclDTraceInfo(info, a, i); TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); @@ -8910,7 +8905,7 @@ TclNRTailcallEval( */ TclMarkTailcall(interp); - TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL, NULL); + TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; return TclNREvalObjv(interp, objc - 1, objv + 1, 0, NULL); } @@ -9094,7 +9089,7 @@ DeleteCoroutine( NRE_callback *rootPtr = TOP_CB(interp); if (COR_IS_SUSPENDED(corPtr)) { - TclNRRunCallbacks(interp, RewindCoroutine(corPtr, TCL_OK), rootPtr); + TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr); } } @@ -9316,7 +9311,7 @@ TclNREvalList( Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); - TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL, NULL); + TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } @@ -9835,7 +9830,7 @@ TclNRCoroutineObjCmd( Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); - for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr, &hSearch); + for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch); hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) { int isNew; Tcl_HashEntry *newPtr = diff --git a/generic/tclBinary.c b/generic/tclBinary.c index b2e9e03..d95452b 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -183,16 +183,14 @@ typedef struct { * above. */ } ByteArray; -#define BYTEARRAY_MAX_LEN \ - (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes)) +#define BYTEARRAY_MAX_LEN (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes)) #define BYTEARRAY_SIZE(len) \ - ( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \ + ( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \ ? (Tcl_Panic("negative length specified or max size of a Tcl value exceeded"), 0) \ : (offsetof(ByteArray, bytes) + (len)) ) -#define GET_BYTEARRAY(irPtr) \ - ((ByteArray *) (irPtr)->twoPtrValue.ptr1) +#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1) #define SET_BYTEARRAY(irPtr, baPtr) \ - (irPtr)->twoPtrValue.ptr1 = (baPtr) + (irPtr)->twoPtrValue.ptr1 = (baPtr) int TclIsPureByteArray( @@ -442,7 +440,7 @@ unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ Tcl_Size numBytes) /* Number of bytes in resized array - * Must be >= 0 */ + * Must be >= 0 */ { ByteArray *byteArrayPtr; Tcl_ObjInternalRep *irPtr; @@ -738,7 +736,7 @@ TclAppendBytesToByteArray( Tcl_ObjInternalRep *irPtr; if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "TclAppendBytesToByteArray"); + Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); } if (len < 0) { Tcl_Panic("%s must be called with definite number of bytes to append", @@ -2042,7 +2040,7 @@ FormatNumber( if (fabs(dvalue) > (FLT_MAX + pow(2, (FLT_MAX_EXP - FLT_MANT_DIG - 1)))) { fvalue = (dvalue >= 0.0) ? INFINITY : -INFINITY; // c99 } else { - fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; + fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; } } else { fvalue = (float) dvalue; @@ -2588,19 +2586,19 @@ BinaryDecodeHex( */ #define OUTPUT(c) \ - do { \ - *cursor++ = (c); \ - outindex++; \ - if (maxlen > 0 && cursor != limit) { \ - if (outindex == maxlen) { \ - memcpy(cursor, wrapchar, wrapcharlen); \ - cursor += wrapcharlen; \ - outindex = 0; \ - } \ - } \ - if (cursor > limit) { \ - Tcl_Panic("limit hit"); \ - } \ + do { \ + *cursor++ = (c); \ + outindex++; \ + if (maxlen > 0 && cursor != limit) { \ + if (outindex == maxlen) { \ + memcpy(cursor, wrapchar, wrapcharlen); \ + cursor += wrapcharlen; \ + outindex = 0; \ + } \ + } \ + if (cursor > limit) { \ + Tcl_Panic("limit hit"); \ + } \ } while (0) static int @@ -2785,8 +2783,7 @@ BinaryEncodeUu( case '\v': case '\f': case '\r': - p++; - numBytes--; + p++; numBytes--; continue; case '\n': numBytes--; diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 707f6d1..a95fc83 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -171,7 +171,7 @@ TclDumpMemoryInfo( char buf[1024]; if (clientData == NULL) { - return 0; + return 0; } snprintf(buf, sizeof(buf), "total mallocs %10" TCL_Z_MODIFIER "u\n" @@ -447,7 +447,7 @@ Tcl_DbCkalloc( } if (alloc_tracing) { - fprintf(stderr, "Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", + fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", result->body, size, file, line); } @@ -536,7 +536,7 @@ Tcl_AttemptDbCkalloc( } if (alloc_tracing) { - fprintf(stderr, "Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", + fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n", result->body, size, file, line); } @@ -826,12 +826,12 @@ MemoryCmd( Tcl_DStringFree(&buffer); if (result != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s", - TclGetString(objv[2]), Tcl_PosixError(interp))); + TclGetString(objv[2]), Tcl_PosixError(interp))); return TCL_ERROR; } return TCL_OK; } - if (strcmp(TclGetString(objv[1]), "break_on_malloc") == 0) { + if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) { Tcl_WideInt value; if (objc != 3) { goto argError; @@ -842,7 +842,7 @@ MemoryCmd( break_on_malloc = value; return TCL_OK; } - if (strcmp(TclGetString(objv[1]), "info") == 0) { + if (strcmp(TclGetString(objv[1]),"info") == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n", "total mallocs", total_mallocs, "total frees", total_frees, @@ -856,7 +856,7 @@ MemoryCmd( if (objc != 3) { goto bad_suboption; } - init_malloced_bodies = (strcmp(TclGetString(objv[2]), "on") == 0); + init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0); return TCL_OK; } if (strcmp(TclGetString(objv[1]), "objs") == 0) { @@ -871,8 +871,8 @@ MemoryCmd( fileP = fopen(fileName, "w"); if (fileP == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot open output file: %s", - Tcl_PosixError(interp))); + "cannot open output file: %s", + Tcl_PosixError(interp))); return TCL_ERROR; } TclDbDumpActiveObjects(fileP); @@ -880,7 +880,7 @@ MemoryCmd( Tcl_DStringFree(&buffer); return TCL_OK; } - if (strcmp(TclGetString(objv[1]), "onexit") == 0) { + if (strcmp(TclGetString(objv[1]),"onexit") == 0) { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "file"); return TCL_ERROR; @@ -890,11 +890,11 @@ MemoryCmd( return TCL_ERROR; } onExitMemDumpFileName = dumpFile; - strcpy(onExitMemDumpFileName, fileName); + strcpy(onExitMemDumpFileName,fileName); Tcl_DStringFree(&buffer); return TCL_OK; } - if (strcmp(TclGetString(objv[1]), "tag") == 0) { + if (strcmp(TclGetString(objv[1]),"tag") == 0) { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "file"); return TCL_ERROR; @@ -908,15 +908,15 @@ MemoryCmd( memcpy(curTagPtr->string, TclGetString(objv[2]), len + 1); return TCL_OK; } - if (strcmp(TclGetString(objv[1]), "trace") == 0) { + if (strcmp(TclGetString(objv[1]),"trace") == 0) { if (objc != 3) { goto bad_suboption; } - alloc_tracing = (strcmp(TclGetString(objv[2]), "on") == 0); + alloc_tracing = (strcmp(TclGetString(objv[2]),"on") == 0); return TCL_OK; } - if (strcmp(TclGetString(objv[1]), "trace_on_at_malloc") == 0) { + if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) { Tcl_WideInt value; if (objc != 3) { goto argError; @@ -927,18 +927,18 @@ MemoryCmd( trace_on_at_malloc = value; return TCL_OK; } - if (strcmp(TclGetString(objv[1]), "validate") == 0) { + if (strcmp(TclGetString(objv[1]),"validate") == 0) { if (objc != 3) { goto bad_suboption; } - validate_memory = (strcmp(TclGetString(objv[2]), "on") == 0); + validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": should be active, break_on_malloc, info, " - "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", - TclGetString(objv[1]))); + "bad option \"%s\": should be active, break_on_malloc, info, " + "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", + TclGetString(objv[1]))); return TCL_ERROR; argError: diff --git a/generic/tclClock.c b/generic/tclClock.c index 1675f54..412f616 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -349,7 +349,7 @@ ClockConfigureClear( */ static void ClockDeleteCmdProc( - void *clientData) /* Opaque pointer to the client data */ + void *clientData) /* Opaque pointer to the client data */ { ClockClientData *data = (ClockClientData *)clientData; int i; @@ -649,7 +649,7 @@ NormLocaleObj( if ((localeObj->length == 1 /* C */ && strcasecmp(loc, Literals[LIT_C]) == 0) || (dataPtr->defaultLocale && (loc2 = TclGetString(dataPtr->defaultLocale)) - && localeObj->length == dataPtr->defaultLocale->length + && localeObj->length == dataPtr->defaultLocale->length && strcasecmp(loc, loc2) == 0)) { *mcDictObj = dataPtr->defaultLocaleDict; return dataPtr->defaultLocale ? @@ -3287,7 +3287,7 @@ ClockParseFmtScnArgs( ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ TclDateFields *date, /* Extracted date-time corresponding base * (by scan or add) resp. clockval (by format) */ - Tcl_Size objc, /* Parameter count */ + Tcl_Size objc, /* Parameter count */ Tcl_Obj *const objv[], /* Parameter vector */ ClockOperation operation, /* What operation are we doing: format, scan, add */ const char *syntax) /* Syntax of the current command */ @@ -3480,7 +3480,7 @@ ClockParseFmtScnArgs( /* extact fields from base */ date->seconds = baseVal; if (ClockGetDateFields(dataPtr, interp, date, opts->timezoneObj, - GREGORIAN_CHANGE_DATE) != TCL_OK) { + GREGORIAN_CHANGE_DATE) != TCL_OK) { /* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */ return TCL_ERROR; } @@ -3504,7 +3504,7 @@ ClockParseFmtScnArgs( /*---------------------------------------------------------------------- * - * ClockFormatObjCmd, [clock format] -- + * ClockFormatObjCmd -- , clock format -- * * This function is invoked to process the Tcl "clock format" command. * @@ -3573,7 +3573,7 @@ ClockFormatObjCmd( /*---------------------------------------------------------------------- * - * ClockScanObjCmd, [clock scan] -- + * ClockScanObjCmd -- , clock scan -- * * This function is invoked to process the Tcl "clock scan" command. * @@ -3630,8 +3630,7 @@ ClockScanObjCmd( } /* seconds are in localSeconds (relative base date), so reset time here */ - yyHour = yyMinutes = yySeconds = yySecondOfDay = 0; - yyMeridian = MER24; + yyHour = yyMinutes = yySeconds = yySecondOfDay = 0; yyMeridian = MER24; /* If free scan */ if (opts.formatObj == NULL) { @@ -4310,7 +4309,7 @@ ClockWeekdaysOffs( /*---------------------------------------------------------------------- * - * ClockAddObjCmd, [clock add] -- + * ClockAddObjCmd -- , clock add -- * * Adds an offset to a given time. * @@ -4567,16 +4566,16 @@ ClockSafeCatchCmd( Tcl_Obj *const objv[]) { typedef struct { - int status; /* return code status */ - int flags; /* Each remaining field saves the */ - int returnLevel; /* corresponding field of the Interp */ - int returnCode; /* struct. These fields taken together are */ - Tcl_Obj *errorInfo; /* the "state" of the interp. */ - Tcl_Obj *errorCode; - Tcl_Obj *returnOpts; - Tcl_Obj *objResult; - Tcl_Obj *errorStack; - int resetErrorStack; + int status; /* return code status */ + int flags; /* Each remaining field saves the */ + int returnLevel; /* corresponding field of the Interp */ + int returnCode; /* struct. These fields taken together are */ + Tcl_Obj *errorInfo; /* the "state" of the interp. */ + Tcl_Obj *errorCode; + Tcl_Obj *returnOpts; + Tcl_Obj *objResult; + Tcl_Obj *errorStack; + int resetErrorStack; } InterpState; Interp *iPtr = (Interp *)interp; diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 8340ece..0afc458 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -632,11 +632,11 @@ ClockFmtScnStorageDelete( */ static const Tcl_ObjType ClockFmtObjType = { - "clock-format", /* name */ - ClockFmtObj_FreeInternalRep,/* freeIntRepProc */ - ClockFmtObj_DupInternalRep, /* dupIntRepProc */ - ClockFmtObj_UpdateString, /* updateStringProc */ - ClockFmtObj_SetFromAny, /* setFromAnyProc */ + "clock-format", /* name */ + ClockFmtObj_FreeInternalRep, /* freeIntRepProc */ + ClockFmtObj_DupInternalRep, /* dupIntRepProc */ + ClockFmtObj_UpdateString, /* updateStringProc */ + ClockFmtObj_SetFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; @@ -1046,9 +1046,7 @@ FindTokenBegin( goto findChar; case CTOKT_SPACE: - while (!isspace(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) { - // empty body - } + while (!isspace(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) {} return p; case CTOKT_CHAR: @@ -2142,13 +2140,13 @@ EstimateTokenCount( return ++tokcnt; } -#define AllocTokenInChain(tok, chain, tokCnt, type) \ - if (++(tok) >= (chain) + (tokCnt)) { \ - chain = (type)Tcl_Realloc((char *)(chain), \ - (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok)));\ - (tok) = (chain) + (tokCnt); \ - (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ - } \ +#define AllocTokenInChain(tok, chain, tokCnt, type) \ + if (++(tok) >= (chain) + (tokCnt)) { \ + chain = (type)Tcl_Realloc((char *)(chain), \ + (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \ + (tok) = (chain) + (tokCnt); \ + (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ + } \ memset(tok, 0, sizeof(*(tok))); /* @@ -2295,7 +2293,7 @@ ClockGetOrParseScanFormat( tokCnt++; continue; } - word_tok: + word_tok: { /* try continue with previous word token */ ClockScanToken *wordTok = tok - 1; @@ -3338,7 +3336,8 @@ ClockGetOrParseFmtFormat( continue; } default: - word_tok: { + word_tok: + { /* try continue with previous word token */ ClockFormatToken *wordTok = tok - 1; diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index ce96c9b..ab5fbb0 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -405,21 +405,21 @@ TclInitEncodingCmd( * * EncodingConvertParseOptions -- * - * Common routine for parsing arguments passed to encoding convertfrom - * and encoding convertto. + * Common routine for parsing arguments passed to encoding convertfrom + * and encoding convertto. * * Results: - * TCL_OK or TCL_ERROR. + * TCL_OK or TCL_ERROR. * * Side effects: - * On success, - * - *encPtr is set to the encoding. Must be freed with Tcl_FreeEncoding - * if non-NULL - * - *dataObjPtr is set to the Tcl_Obj containing the data to encode or - * decode - * - *profilePtr is set to encoding error handling profile - * - *failVarPtr is set to -failindex option value or NULL - * On error, all of the above are uninitialized. + * On success, + * - *encPtr is set to the encoding. Must be freed with Tcl_FreeEncoding + * if non-NULL + * - *dataObjPtr is set to the Tcl_Obj containing the data to encode or + * decode + * - *profilePtr is set to encoding error handling profile + * - *failVarPtr is set to -failindex option value or NULL + * On error, all of the above are uninitialized. * *------------------------------------------------------------------------ */ @@ -524,7 +524,7 @@ EncodingConvertfromObjCmd( Tcl_Obj *data; /* Byte array to convert */ Tcl_DString ds; /* Buffer to hold the string */ Tcl_Encoding encoding; /* Encoding to use */ - Tcl_Size length = 0; /* Length of the byte array being converted */ + Tcl_Size length = 0; /* Length of the byte array being converted */ const char *bytesPtr; /* Pointer to the first byte of the array */ int flags; int result; @@ -2346,13 +2346,13 @@ StoreStatData( if (varName == NULL) { TclNewObj(result); Tcl_IncrRefCount(result); -#define DOBJPUT(key, objValue) \ - Tcl_DictObjPut(NULL, result, \ - Tcl_NewStringObj((key), TCL_AUTO_LENGTH), \ - (objValue)); +#define DOBJPUT(key, objValue) \ + Tcl_DictObjPut(NULL, result, \ + Tcl_NewStringObj((key), -1), \ + (objValue)); DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev)); DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino)); - DOBJPUT("nlink",Tcl_NewWideIntObj((long)statPtr->st_nlink)); + DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink)); DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid)); DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid)); DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size)); @@ -2362,12 +2362,12 @@ StoreStatData( #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize)); #endif - DOBJPUT("atime",Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr))); - DOBJPUT("mtime",Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr))); - DOBJPUT("ctime",Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr))); + DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr))); + DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr))); + DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr))); mode = (unsigned short) statPtr->st_mode; DOBJPUT("mode", Tcl_NewWideIntObj(mode)); - DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), TCL_AUTO_LENGTH)); + DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1)); #undef DOBJPUT Tcl_SetObjResult(interp, result); Tcl_DecrRefCount(result); @@ -2384,8 +2384,7 @@ StoreStatData( TclNewLiteralStringObj(field, fieldName); \ Tcl_IncrRefCount(field); \ value = (object); \ - if (Tcl_ObjSetVar2(interp, varName, field, value, \ - TCL_LEAVE_ERR_MSG) == NULL) { \ + if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \ TclDecrRefCount(field); \ return TCL_ERROR; \ } \ @@ -2833,7 +2832,7 @@ EachloopCmd( &statePtr->varcList[i], &statePtr->varvList[i]); /* Values */ - if (TclObjTypeHasProc(objv[2+i*2], indexProc)) { + if (TclObjTypeHasProc(objv[2+i*2],indexProc)) { /* Special case for AbstractList */ statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]); if (statePtr->aCopyList[i] == NULL) { @@ -2983,7 +2982,7 @@ ForeachAssignments( for (i=0 ; inumLists ; i++) { int isAbstractList = - TclObjTypeHasProc(statePtr->aCopyList[i], indexProc) != NULL; + TclObjTypeHasProc(statePtr->aCopyList[i],indexProc) != NULL; for (v=0 ; vvarcList[i] ; v++) { k = statePtr->index[i]++; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 562908e..37c9822 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -788,7 +788,7 @@ InfoCommandsCmd( cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { - if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) { + if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); } @@ -1263,7 +1263,7 @@ TclInfoFrame( { Interp *iPtr = (Interp *) interp; Tcl_Obj *tmpObj; - Tcl_Obj *lv[20] = {NULL}; /* Keep uptodate when more keys are added to + Tcl_Obj *lv[20] = {NULL}; /* Keep uptodate when more keys are added to * the dict. */ int lc = 0; /* @@ -1282,8 +1282,8 @@ TclInfoFrame( */ #define ADD_PAIR(name, value) \ - TclNewLiteralStringObj(tmpObj, name); \ - lv[lc++] = tmpObj; \ + TclNewLiteralStringObj(tmpObj, name); \ + lv[lc++] = tmpObj; \ lv[lc++] = (value) switch (framePtr->type) { @@ -2426,7 +2426,7 @@ int Tcl_LinsertObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; @@ -2519,8 +2519,9 @@ int Tcl_ListObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* The argument objects. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) + /* The argument objects. */ { /* * If there are no list elements, the result is an empty object. @@ -2555,7 +2556,8 @@ Tcl_LlengthObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) + /* Argument objects. */ { Tcl_Size listLen; int result; @@ -2603,7 +2605,8 @@ Tcl_LpopObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) + /* Argument objects. */ { Tcl_Size listLen; int copied = 0, result; @@ -2722,7 +2725,8 @@ Tcl_LrangeObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) + /* Argument objects. */ { int result; Tcl_Size listLen, first, last; @@ -2933,8 +2937,9 @@ int Tcl_LrepeatObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* The argument objects. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) + /* The argument objects. */ { Tcl_WideInt elementCount, i; Tcl_Size totalElems; @@ -3869,7 +3874,7 @@ Tcl_LsearchObjCmd( break; case REAL: - result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble); + result = Tcl_GetDoubleFromObj(interp,itemPtr, &objDouble); if (result != TCL_OK) { if (listPtr) { Tcl_DecrRefCount(listPtr); @@ -4029,10 +4034,10 @@ Tcl_LsearchObjCmd( static SequenceDecoded SequenceIdentifyArgument( - Tcl_Interp *interp, /* for error reporting */ - Tcl_Obj *argPtr, /* Argument to decode */ - Tcl_Obj **numValuePtr, /* Return numeric value */ - int *keywordIndexPtr) /* Return keyword enum */ + Tcl_Interp *interp, /* for error reporting */ + Tcl_Obj *argPtr, /* Argument to decode */ + Tcl_Obj **numValuePtr, /* Return numeric value */ + int *keywordIndexPtr) /* Return keyword enum */ { int status; SequenceOperators opmode; @@ -4164,48 +4169,49 @@ Tcl_LseqObjCmd( * digit. */ if (objc > 6) { - /* Too many arguments */ - arg_key=0; + /* Too many arguments */ + arg_key=0; } else for (i=1; i end) || /* Range begins after end of string */ (last < first)) { /* Range begins after it starts */ /* @@ -2907,7 +2907,7 @@ StringLowerCmd( Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; - if (TclGetIntForIndexM(interp, objv[2], length1, &first) != TCL_OK) { + if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { @@ -2992,7 +2992,7 @@ StringUpperCmd( Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; - if (TclGetIntForIndexM(interp, objv[2], length1, &first) != TCL_OK) { + if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { @@ -3077,7 +3077,7 @@ StringTitleCmd( Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; - if (TclGetIntForIndexM(interp, objv[2], length1, &first) != TCL_OK) { + if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { @@ -3702,7 +3702,7 @@ TclNRSwitchObjCmd( } break; case OPT_GLOB: - if (Tcl_StringCaseMatch(TclGetString(stringObj), pattern, noCase)) { + if (Tcl_StringCaseMatch(TclGetString(stringObj),pattern,noCase)) { goto matchFound; } break; @@ -5309,7 +5309,7 @@ TclListLines( Tcl_Size line, /* Line the list as a whole starts on. */ Tcl_Size n, /* #elements in lines */ Tcl_Size *lines, /* Array of line numbers, to fill. */ - Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of + Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of * derived continuation data */ { const char *listStr = TclGetString(listObj); diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 30244ee..bad58f6 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -379,9 +379,9 @@ TclCompileArraySetCmd( localIndex = TclFindCompiledLocal(varTokenPtr->start, varTokenPtr->size, 1, envPtr); PushStringLiteral(envPtr, "0"); - TclEmitInstInt4(INST_REVERSE, 2, envPtr); + TclEmitInstInt4(INST_REVERSE, 2, envPtr); TclEmitInstInt4(INST_UPVAR, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + TclEmitOpcode(INST_POP, envPtr); } /* @@ -391,11 +391,9 @@ TclCompileArraySetCmd( keyVar = AnonymousLocal(envPtr); valVar = AnonymousLocal(envPtr); - infoPtr = (ForeachInfo *) - Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *)); + infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *)); infoPtr->numLists = 1; - infoPtr->varLists[0] = (ForeachVarList *) - Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(Tcl_Size)); + infoPtr->varLists[0] = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(Tcl_Size)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; @@ -969,7 +967,7 @@ TclCompileConstCmd( * that. */ if (!isScalar) { - return TCL_ERROR; + return TCL_ERROR; } /* @@ -1162,7 +1160,7 @@ TclCompileDictIncrCmd( incrTokenPtr = TokenAfter(keyTokenPtr); if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr); + return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr); } word = incrTokenPtr[1].start; numBytes = incrTokenPtr[1].size; @@ -1172,7 +1170,7 @@ TclCompileDictIncrCmd( code = TclGetIntFromObj(NULL, intObj, &incrAmount); TclDecrRefCount(intObj); if (code != TCL_OK) { - return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr); + return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr); } } else { incrAmount = 1; @@ -2001,7 +1999,7 @@ TclCompileDictAppendCmd( tokenPtr = TokenAfter(parsePtr->tokenPtr); dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr); if (dictVarIndex < 0) { - return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); + return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr); } /* @@ -2967,7 +2965,7 @@ CompileEachloopCmd( static void * DupForeachInfo( - void *clientData) /* The foreach command's compilation auxiliary + void *clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { ForeachInfo *srcPtr = (ForeachInfo *)clientData; @@ -3016,7 +3014,7 @@ DupForeachInfo( static void FreeForeachInfo( - void *clientData) /* The foreach command's compilation auxiliary + void *clientData) /* The foreach command's compilation auxiliary * data to free. */ { ForeachInfo *infoPtr = (ForeachInfo *)clientData; @@ -3350,7 +3348,7 @@ TclCompileFormatCmd( start = TclGetString(formatObj); /* The start of the currently-scanned literal * in the format string. */ - TclNewObj(tmpObj); /* The buffer used to accumulate the literal + TclNewObj(tmpObj); /* The buffer used to accumulate the literal * being built. */ for (bytes = start ; *bytes ; bytes++) { if (*bytes == '%') { @@ -3452,7 +3450,7 @@ TclLocalScalar( { Tcl_Token token[2] = { {TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, - {TCL_TOKEN_TEXT, NULL, 0, 0} + {TCL_TOKEN_TEXT, NULL, 0, 0} }; token[1].start = bytes; @@ -3600,35 +3598,34 @@ TclPushVarName( elNameLen = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1; if (!(flags & TCL_NO_ELEMENT)) { - if (remainingLen) { - /* - * Make a first token with the extra characters in the first - * token. - */ - - elemTokenPtr = (Tcl_Token *) - TclStackAlloc(interp, n * sizeof(Tcl_Token)); - allocedTokens = 1; - elemTokenPtr->type = TCL_TOKEN_TEXT; - elemTokenPtr->start = elName; - elemTokenPtr->size = remainingLen; - elemTokenPtr->numComponents = 0; - elemTokenCount = n; - - /* - * Copy the remaining tokens. - */ - - memcpy(elemTokenPtr + 1, varTokenPtr + 2, - (n-1) * sizeof(Tcl_Token)); - } else { - /* - * Use the already available tokens. - */ - - elemTokenPtr = &varTokenPtr[2]; - elemTokenCount = n - 1; - } + if (remainingLen) { + /* + * Make a first token with the extra characters in the first + * token. + */ + + elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, n * sizeof(Tcl_Token)); + allocedTokens = 1; + elemTokenPtr->type = TCL_TOKEN_TEXT; + elemTokenPtr->start = elName; + elemTokenPtr->size = remainingLen; + elemTokenPtr->numComponents = 0; + elemTokenCount = n; + + /* + * Copy the remaining tokens. + */ + + memcpy(elemTokenPtr+1, varTokenPtr+2, + (n-1) * sizeof(Tcl_Token)); + } else { + /* + * Use the already available tokens. + */ + + elemTokenPtr = &varTokenPtr[2]; + elemTokenCount = n - 1; + } } } } diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 6941afa..8e44f96 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -523,7 +523,7 @@ TclCompileIncrCmd( * Emit the instruction to increment the variable. */ - if (isScalar) { /* Simple scalar variable. */ + if (isScalar) { /* Simple scalar variable. */ if (localIndex >= 0) { if (haveImmValue) { TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr); @@ -2024,7 +2024,7 @@ TclCompileRegexpCmd( if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact, NULL) == TCL_OK) { simple = 1; - PushLiteral(envPtr, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); + PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); } } @@ -2208,8 +2208,7 @@ TclCompileRegsubCmd( isSimpleGlob: for (bytes = TclGetString(replacementObj); *bytes; bytes++) { switch (*bytes) { - case '\\': - case '&': + case '\\': case '&': goto done; } } diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 968cc73..bc37155 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -1129,66 +1129,66 @@ TclCompileStringReplaceCmd( } if (parsePtr->numWords == 5) { - /* - * When we have a string replacement, we have to take care about - * not replacing empty substrings that [string replace] promises - * not to replace - * - * The remaining index values might be suitable for conventional - * string replacement, but only if they cannot possibly meet the - * conditions described above at runtime. If there's a chance they - * might, we would have to emit bytecode to check and at that point - * we're paying more in bytecode execution time than would make - * things worthwhile. Trouble is we are very limited in - * how much we can detect that at compile time. After decoding, - * we need, first: - * - * (first <= end) - * - * The encoded indices (first <= TCL_INDEX END) and - * (first == TCL_INDEX_NONE) always meets this condition, but - * any other encoded first index has some list for which it fails. - * - * We also need, second: - * - * (last >= 0) - * - * The encoded index (last >= TCL_INDEX_START) always meet this - * condition but any other encoded last index has some list for - * which it fails. - * - * Finally we need, third: - * - * (first <= last) - * - * Considered in combination with the constraints we already have, - * we see that we can proceed when (first == TCL_INDEX_NONE). - * These also permit simplification of the prefix|replace|suffix - * construction. The other constraints, though, interfere with - * getting a guarantee that first <= last. - */ - - if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) { - /* empty prefix */ - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 4); - OP4( REVERSE, 2); - if (last == INT_MAX) { - OP( POP); /* Pop original */ - } else { - OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END); - OP1( STR_CONCAT1, 2); - } - return TCL_OK; - } + /* + * When we have a string replacement, we have to take care about + * not replacing empty substrings that [string replace] promises + * not to replace + * + * The remaining index values might be suitable for conventional + * string replacement, but only if they cannot possibly meet the + * conditions described above at runtime. If there's a chance they + * might, we would have to emit bytecode to check and at that point + * we're paying more in bytecode execution time than would make + * things worthwhile. Trouble is we are very limited in + * how much we can detect that at compile time. After decoding, + * we need, first: + * + * (first <= end) + * + * The encoded indices (first <= TCL_INDEX END) and + * (first == TCL_INDEX_NONE) always meets this condition, but + * any other encoded first index has some list for which it fails. + * + * We also need, second: + * + * (last >= 0) + * + * The encoded index (last >= TCL_INDEX_START) always meet this + * condition but any other encoded last index has some list for + * which it fails. + * + * Finally we need, third: + * + * (first <= last) + * + * Considered in combination with the constraints we already have, + * we see that we can proceed when (first == TCL_INDEX_NONE). + * These also permit simplification of the prefix|replace|suffix + * construction. The other constraints, though, interfere with + * getting a guarantee that first <= last. + */ - if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) { - OP44( STR_RANGE_IMM, 0, first-1); - tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 4); + if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) { + /* empty prefix */ + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 4); + OP4( REVERSE, 2); + if (last == INT_MAX) { + OP( POP); /* Pop original */ + } else { + OP44( STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END); OP1( STR_CONCAT1, 2); - return TCL_OK; } + return TCL_OK; + } + + if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) { + OP44( STR_RANGE_IMM, 0, first-1); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 4); + OP1( STR_CONCAT1, 2); + return TCL_OK; + } /* FLOW THROUGH TO genericReplace */ @@ -1474,12 +1474,12 @@ TclCompileSubstCmd( wordTokenPtr = TokenAfter(wordTokenPtr); } -#if 0 +/* if (TclSubstOptions(NULL, numOpts, objv, &flags) == TCL_OK) { toSubst = objv[numOpts]; Tcl_IncrRefCount(toSubst); } -#endif +*/ /* TODO: Figure out expansion to cover WordKnownAtCompileTime * The difficulty is that WKACT makes a copy, and if TclSubstParse @@ -2115,7 +2115,7 @@ IssueSwitchChainedTests( * switch can match against and bodies to * execute when the match succeeds. */ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */ - Tcl_Size *bodyLines, /* Array of line numbers for body list + Tcl_Size *bodyLines, /* Array of line numbers for body list * items. */ Tcl_Size **bodyContLines) /* Array of continuation line info. */ { @@ -2123,8 +2123,7 @@ IssueSwitchChainedTests( int foundDefault; /* Flag to indicate whether a "default" clause * is present. */ JumpFixup *fixupArray; /* Array of forward-jump fixup records. */ - unsigned int *fixupTargetArray; - /* Array of places for fixups to point at. */ + unsigned int *fixupTargetArray; /* Array of places for fixups to point at. */ int fixupCount; /* Number of places to fix up. */ int contFixIndex; /* Where the first of the jumps due to a group * of continuation bodies starts, or -1 if @@ -2364,7 +2363,7 @@ IssueSwitchJumpTable( * switch can match against and bodies to * execute when the match succeeds. */ Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */ - Tcl_Size *bodyLines, /* Array of line numbers for body list + Tcl_Size *bodyLines, /* Array of line numbers for body list * items. */ Tcl_Size **bodyContLines) /* Array of continuation line info. */ { diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 5e36a86..5c46afd 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -746,7 +746,7 @@ ParseExpr( */ Tcl_ListObjAppendElement(NULL, funcList, literal); - } else if (Tcl_GetBooleanFromObj(NULL, literal, &b) == TCL_OK) { + } else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) { lexeme = BOOLEAN; } else { /* @@ -1869,8 +1869,8 @@ Tcl_ParseExpr( { int code; OpNode *opTree = NULL; /* Will point to the tree of operators. */ - Tcl_Obj *litList; /* List to hold the literals. */ - Tcl_Obj *funcList; /* List to hold the functon names. */ + Tcl_Obj *litList; /* List to hold the literals. */ + Tcl_Obj *funcList; /* List to hold the functon names. */ Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions. */ diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 427ce3e..38070b6 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -397,17 +397,17 @@ InstructionDesc const tclInstructionTable[] = { * stktop; op1 is 1 for errors on problems, 0 otherwise */ {"dictExpand", 1, -1, 0, {OPERAND_NONE}}, - /* Probe into a dict and extract it (or a subdict of it) into - * variables with matched names. Produces list of keys bound as - * result. Part of [dict with]. + /* Probe into a dict and extract it (or a subdict of it) into + * variables with matched names. Produces list of keys bound as + * result. Part of [dict with]. * Stack: ... dict path => ... keyList */ {"dictRecombineStk", 1, -3, 0, {OPERAND_NONE}}, - /* Map variable contents back into a dictionary in a variable. Part of - * [dict with]. + /* Map variable contents back into a dictionary in a variable. Part of + * [dict with]. * Stack: ... dictVarName path keyList => ... */ {"dictRecombineImm", 5, -2, 1, {OPERAND_LVT4}}, - /* Map variable contents back into a dictionary in the local variable - * indicated by the LVT index. Part of [dict with]. + /* Map variable contents back into a dictionary in the local variable + * indicated by the LVT index. Part of [dict with]. * Stack: ... path keyList => ... */ {"dictExists", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* The top op4 words (min 1) are a key path into the dictionary just @@ -637,7 +637,7 @@ InstructionDesc const tclInstructionTable[] = { * Stack: ... varName list => ... listVarContents */ {"clockRead", 2, +1, 1, {OPERAND_UINT1}}, - /* Read clock out to the stack. Operand is which clock to read + /* Read clock out to the stack. Operand is which clock to read * 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds. * Stack: ... => ... time */ @@ -779,7 +779,7 @@ TclSetByteCodeFromAny( * compiled. Must not be NULL. */ Tcl_Obj *objPtr, /* The object to make a ByteCode object. */ CompileHookProc *hookProc, /* Procedure to invoke after compilation. */ - void *clientData) /* Hook procedure private data. */ + void *clientData) /* Hook procedure private data. */ { Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated @@ -996,7 +996,7 @@ DupByteCodeInternalRep( static void FreeByteCodeInternalRep( - Tcl_Obj *objPtr) /* Object whose internal rep to free. */ + Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; @@ -1046,7 +1046,7 @@ TclReleaseByteCode( static void CleanupByteCode( - ByteCode *codePtr) /* Points to the ByteCode to free. */ + ByteCode *codePtr) /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; Interp *iPtr = (Interp *) interp; @@ -1397,7 +1397,7 @@ CompileSubstObj( static void FreeSubstCodeInternalRep( - Tcl_Obj *objPtr) /* Object whose internal rep to free. */ + Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; @@ -1448,7 +1448,7 @@ void TclInitCompileEnv( Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ - CompileEnv *envPtr, /* Points to the CompileEnv structure to + CompileEnv *envPtr,/* Points to the CompileEnv structure to * initialize. */ const char *stringPtr, /* The source string to be compiled. */ size_t numBytes, /* Number of bytes in source string. */ @@ -2513,8 +2513,8 @@ TclCompileTokens( if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = (Tcl_Size *) Tcl_Realloc(clPosition, - maxNumCL * sizeof(Tcl_Size)); + clPosition = (Tcl_Size *)Tcl_Realloc(clPosition, + maxNumCL * sizeof(Tcl_Size)); } clPosition[numCL] = clPos; numCL ++; @@ -2649,7 +2649,7 @@ TclCompileCmdWord( Tcl_Interp *interp, /* Used for error and status reporting. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens for * a command word to compile inline. */ - size_t count1, /* Number of tokens to consider at tokenPtr. + size_t count1, /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ CompileEnv *envPtr) /* Holds the resulting instructions. */ { @@ -2827,7 +2827,7 @@ PreventCycle( * * NOTE: [Bugs 3392070, 3389764] We make a copy based completely * on the string value, and do not call Tcl_DuplicateObj() so we - * can be sure we do not have any lingering cycles hiding in + * can be sure we do not have any lingering cycles hiding in * the internalrep. */ Tcl_Size numBytes; @@ -3034,7 +3034,7 @@ TclInitByteCodeObj( Tcl_Size TclFindCompiledLocal( - const char *name, /* Points to first character of the name of a + const char *name, /* Points to first character of the name of a * scalar or array variable. If NULL, a * temporary var should be created. */ Tcl_Size nameBytes, /* Number of bytes in the name. */ @@ -3090,7 +3090,7 @@ TclFindCompiledLocal( char *localName = localPtr->name; if ((nameBytes == localPtr->nameLength) && - (strncmp(name, localName, nameBytes) == 0)) { + (strncmp(name,localName,nameBytes) == 0)) { return i; } } @@ -3213,7 +3213,7 @@ EnterCmdStartData( Tcl_Size cmdIndex, /* Index of the command whose start data is * being set. */ Tcl_Size srcOffset, /* Offset of first char of the command. */ - Tcl_Size codeOffset) /* Offset of first byte of command code. */ + Tcl_Size codeOffset) /* Offset of first byte of command code. */ { CmdLocation *cmdLocPtr; @@ -3291,8 +3291,8 @@ EnterCmdExtentData( * location information. */ Tcl_Size cmdIndex, /* Index of the command whose source and code * length data is being set. */ - Tcl_Size numSrcBytes, /* Number of command source chars. */ - Tcl_Size numCodeBytes) /* Offset of last byte of command code. */ + Tcl_Size numSrcBytes, /* Number of command source chars. */ + Tcl_Size numCodeBytes) /* Offset of last byte of command code. */ { CmdLocation *cmdLocPtr; @@ -3775,15 +3775,16 @@ TclFinalizeLoopExceptionRange( Tcl_Size TclCreateAuxData( - void *clientData, /* The compilation auxiliary data to store in + void *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 + CompileEnv *envPtr)/* Points to the CompileEnv for which a new * aux data structure is to be allocated. */ { Tcl_Size index; /* Index for the new AuxData structure. */ - AuxData *auxDataPtr; /* Points to the new AuxData structure */ + AuxData *auxDataPtr; + /* Points to the new AuxData structure */ index = envPtr->auxDataArrayNext; if (index >= envPtr->auxDataArrayEnd) { diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 3d9028e..18d5ed7 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -859,7 +859,7 @@ enum TclInstruction { #define MAX_INSTRUCTION_OPERANDS 2 typedef enum InstOperandType { - OPERAND_NONE, /* No operand. */ + OPERAND_NONE, OPERAND_INT1, /* One byte signed integer. */ OPERAND_INT4, /* Four byte signed integer. */ OPERAND_UINT1, /* One byte unsigned integer. */ @@ -1841,15 +1841,13 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *args do { \ if (tclDTraceDebugEnabled) { \ int _l, _t = 0; \ - if (!tclDTraceDebugLog) { \ - TclDTraceOpenDebugLog(); \ - } \ + if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \ fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", \ - strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \ + strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \ fprintf(tclDTraceDebugLog, " %.*s():%n", \ (_t < 18 ? 18 - _t : 0) + 18, __func__, &_l); _t += _l; \ fprintf(tclDTraceDebugLog, "%*s" p "%n", \ - (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \ + (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \ "", &_l); _t += _l; \ fprintf(tclDTraceDebugLog, "%*s" m "\n", \ (_t < 64 ? 64 - _t : 1), "", ##__VA_ARGS__); \ diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 4708903..9fb2fa7 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -391,7 +391,7 @@ GetConfigDict( static void ConfigDictDeleteProc( - void *clientData, /* Pointer to Tcl_Obj. */ + void *clientData, /* Pointer to Tcl_Obj. */ TCL_UNUSED(Tcl_Interp *)) { Tcl_DecrRefCount((Tcl_Obj *)clientData); diff --git a/generic/tclDate.h b/generic/tclDate.h index a8f306a..fea7cbd 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -103,27 +103,26 @@ typedef enum ClockLiteral { LIT__END } ClockLiteral; -#define CLOCK_LITERAL_ARRAY(litarr) \ - static const char *const litarr[] = { \ - "", \ - "%a %b %d %H:%M:%S %Z %Y", \ - "system", "current", "C", \ - "BCE", "CE", \ - "dayOfMonth", "dayOfWeek", "dayOfYear", \ - "era", ":GMT", "gregorian", \ - "integer value too large to represent", \ - "iso8601Week", "iso8601Year", \ - "julianDay", "localSeconds", \ - "month", \ - "seconds", "tzName", "tzOffset", \ - "year", \ - "::tcl::clock::TZData", \ - "::tcl::clock::GetSystemTimeZone", \ - "::tcl::clock::SetupTimeZone", \ - "::tcl::clock::mcget", \ - "::tcl::clock::GetSystemLocale", "::tcl::clock::mclocale", \ - "::tcl::clock::LocalizeFormat" \ - } +#define CLOCK_LITERAL_ARRAY(litarr) static const char *const litarr[] = { \ + "", \ + "%a %b %d %H:%M:%S %Z %Y", \ + "system", "current", "C", \ + "BCE", "CE", \ + "dayOfMonth", "dayOfWeek", "dayOfYear", \ + "era", ":GMT", "gregorian", \ + "integer value too large to represent", \ + "iso8601Week", "iso8601Year", \ + "julianDay", "localSeconds", \ + "month", \ + "seconds", "tzName", "tzOffset", \ + "year", \ + "::tcl::clock::TZData", \ + "::tcl::clock::GetSystemTimeZone", \ + "::tcl::clock::SetupTimeZone", \ + "::tcl::clock::mcget", \ + "::tcl::clock::GetSystemLocale", "::tcl::clock::mclocale", \ + "::tcl::clock::LocalizeFormat" \ +} /* * Enumeration of the msgcat literals used in [clock] @@ -142,18 +141,17 @@ typedef enum ClockMsgCtLiteral { MCLIT__END } ClockMsgCtLiteral; -#define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) \ - static const char *const litarr[] = { \ - pref "", \ - pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \ - pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", pref "DAYS_OF_WEEK_COMB", \ - pref "AM", pref "PM", \ - pref "LOCALE_ERAS", \ - pref "BCE", pref "CE", \ - pref "b.c.e.", pref "c.e.", \ - pref "b.c.", pref "a.d.", \ - pref "LOCALE_NUMERALS", \ - } +#define CLOCK_LOCALE_LITERAL_ARRAY(litarr, pref) static const char *const litarr[] = { \ + pref "", \ + pref "MONTHS_FULL", pref "MONTHS_ABBREV", pref "MONTHS_COMB", \ + pref "DAYS_OF_WEEK_FULL", pref "DAYS_OF_WEEK_ABBREV", pref "DAYS_OF_WEEK_COMB", \ + pref "AM", pref "PM", \ + pref "LOCALE_ERAS", \ + pref "BCE", pref "CE", \ + pref "b.c.e.", pref "c.e.", \ + pref "b.c.", pref "a.d.", \ + pref "LOCALE_NUMERALS", \ +} /* * Structure containing the fields used in [clock format] and [clock scan] @@ -488,9 +486,8 @@ struct ClockFmtScnStorage { #endif size_t fmtMinAlloc; #if 0 - Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of - * Tcl_HashEntry, stored by - * offset +sizeof(self) */ + Tcl_HashEntry hashEntry /* ClockFmtScnStorage is a derivate of Tcl_HashEntry, + * stored by offset +sizeof(self) */ #endif }; diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index ca86ed8..8c34bb8 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -150,19 +150,19 @@ const Tcl_ObjType tclDictType = { TCL_OBJTYPE_V0 }; -#define DictSetInternalRep(objPtr, dictRepPtr) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.twoPtrValue.ptr1 = (dictRepPtr); \ - ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &tclDictType, &ir); \ +#define DictSetInternalRep(objPtr, dictRepPtr) \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.twoPtrValue.ptr1 = (dictRepPtr); \ + ir.twoPtrValue.ptr2 = NULL; \ + Tcl_StoreInternalRep((objPtr), &tclDictType, &ir); \ } while (0) -#define DictGetInternalRep(objPtr, dictRepPtr) \ - do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &tclDictType); \ - (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL; \ +#define DictGetInternalRep(objPtr, dictRepPtr) \ + do { \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &tclDictType); \ + (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -177,7 +177,7 @@ const Tcl_ObjType tclDictType = { static const Tcl_HashKeyType chainHashType = { TCL_HASH_KEY_TYPE_VERSION, - TCL_HASH_KEY_DIRECT_COMPARE, /* allows compare keys by pointers */ + TCL_HASH_KEY_DIRECT_COMPARE, /* allows compare keys by pointers */ TclHashObjKey, TclCompareObjKeys, AllocChainEntry, @@ -1264,7 +1264,7 @@ Tcl_DictObjNext( void Tcl_DictObjDone( - Tcl_DictSearch *searchPtr) /* Pointer to a hash search context. */ + Tcl_DictSearch *searchPtr) /* Pointer to a hash search context. */ { Dict *dict; @@ -1316,7 +1316,7 @@ Tcl_DictObjPutKeyList( Tcl_Panic("%s called with empty key list", "Tcl_DictObjPutKeyList"); } - dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_CREATE); + dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE); if (dictPtr == NULL) { return TCL_ERROR; } @@ -1374,7 +1374,7 @@ Tcl_DictObjRemoveKeyList( Tcl_Panic("%s called with empty key list", "Tcl_DictObjRemoveKeyList"); } - dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_UPDATE); + dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE); if (dictPtr == NULL) { return TCL_ERROR; } @@ -1612,7 +1612,7 @@ DictGetCmd( * Note that this loop always executes at least once. */ - dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2, DICT_PATH_READ); + dictPtr = TclTraceDictPath(interp, objv[1], objc-3,objv+2, DICT_PATH_READ); if (dictPtr == NULL) { return TCL_ERROR; } @@ -2005,7 +2005,7 @@ DictValuesCmd( } listPtr = Tcl_NewListObj(0, NULL); for (; !done ; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) { - if (pattern==NULL || Tcl_StringMatch(TclGetString(valuePtr), pattern)) { + if (pattern==NULL || Tcl_StringMatch(TclGetString(valuePtr),pattern)) { /* * Assume this operation always succeeds. */ @@ -2144,7 +2144,7 @@ DictExistsCmd( return TCL_ERROR; } - dictPtr = TclTraceDictPath(NULL, objv[1], objc-3, objv+2, DICT_PATH_EXISTS); + dictPtr = TclTraceDictPath(NULL, objv[1], objc-3, objv+2,DICT_PATH_EXISTS); if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT || Tcl_DictObjGet(NULL, dictPtr, objv[objc-1], &valuePtr) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); @@ -2809,7 +2809,7 @@ DictMapNRCmd( * Run the script. */ - TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL, NULL, NULL); + TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); return TclNREvalObjEx(interp, storagePtr->scriptObj, 0, iPtr->cmdFramePtr, 3); @@ -2899,7 +2899,7 @@ DictMapLoopCallback( * Run the script. */ - TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL, NULL, NULL); + TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL); return TclNREvalObjEx(interp, storagePtr->scriptObj, 0, iPtr->cmdFramePtr, 3); @@ -3080,7 +3080,7 @@ DictFilterCmd( return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType", - 0, &index) != TCL_OK) { + 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -3390,7 +3390,7 @@ DictUpdateCmd( objPtr = Tcl_NewListObj(objc-3, objv+2); Tcl_IncrRefCount(objPtr); Tcl_IncrRefCount(objv[1]); - TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL, NULL); + TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL); return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1); } diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 1d2436c..5a64ff8 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -557,69 +557,56 @@ FormatInstruction( for (i = 0; i < instDesc->numOperands; i++) { switch (instDesc->opTypes[i]) { case OPERAND_INT1: - opnd = TclGetInt1AtPtr(pc+numBytes); - numBytes++; + opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++; Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_INT4: - opnd = TclGetInt4AtPtr(pc+numBytes); - numBytes += 4; + opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_UINT1: - opnd = TclGetUInt1AtPtr(pc+numBytes); - numBytes++; + opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_UINT4: - opnd = TclGetUInt4AtPtr(pc+numBytes); - numBytes += 4; + opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; if (opCode == INST_START_CMD) { - snprintf(suffixBuffer+strlen(suffixBuffer), - sizeof(suffixBuffer) - strlen(suffixBuffer), + snprintf(suffixBuffer+strlen(suffixBuffer), sizeof(suffixBuffer) - strlen(suffixBuffer), ", %u cmds start here", opnd); } Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_OFFSET1: - opnd = TclGetInt1AtPtr(pc+numBytes); - numBytes++; + opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++; snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd); Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_OFFSET4: - opnd = TclGetInt4AtPtr(pc+numBytes); - numBytes += 4; + opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; if (opCode == INST_START_CMD) { - snprintf(suffixBuffer, sizeof(suffixBuffer), - "next cmd at pc %u", pcOffset+opnd); + snprintf(suffixBuffer, sizeof(suffixBuffer), "next cmd at pc %u", pcOffset+opnd); } else { - snprintf(suffixBuffer, sizeof(suffixBuffer), - "pc %u", pcOffset+opnd); + snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd); } Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_LIT1: - opnd = TclGetUInt1AtPtr(pc+numBytes); - numBytes++; + opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; suffixObj = codePtr->objArrayPtr[opnd]; Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_LIT4: - opnd = TclGetUInt4AtPtr(pc+numBytes); - numBytes += 4; + opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; suffixObj = codePtr->objArrayPtr[opnd]; Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_AUX4: - opnd = TclGetUInt4AtPtr(pc+numBytes); - numBytes += 4; + opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); auxPtr = &codePtr->auxDataArrayPtr[opnd]; break; case OPERAND_IDX4: - opnd = TclGetInt4AtPtr(pc+numBytes); - numBytes += 4; + opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; if (opnd >= -1) { Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd); } else if (opnd == -2) { @@ -638,16 +625,14 @@ FormatInstruction( printLVTindex: if (localPtr != NULL) { if (opnd >= localCt) { - Tcl_Panic("FormatInstruction: bad local var index %u (%" - TCL_SIZE_MODIFIER "d locals)", + Tcl_Panic("FormatInstruction: bad local var index %u (%" TCL_SIZE_MODIFIER "d locals)", opnd, localCt); } for (j = 0; j < opnd; j++) { localPtr = localPtr->nextPtr; } if (TclIsVarTemporary(localPtr)) { - snprintf(suffixBuffer, sizeof(suffixBuffer), - "temp var %u", opnd); + snprintf(suffixBuffer, sizeof(suffixBuffer), "temp var %u", opnd); } else { snprintf(suffixBuffer, sizeof(suffixBuffer), "var "); suffixSrc = localPtr->name; @@ -656,8 +641,7 @@ FormatInstruction( Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", opnd); break; case OPERAND_SCLS1: - opnd = TclGetUInt1AtPtr(pc+numBytes); - numBytes++; + opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; Tcl_AppendPrintfToObj(bufferObj, "%s ", tclStringClassTable[opnd].name); break; @@ -719,8 +703,8 @@ TclGetInnerContext( case INST_TRY_CVT_TO_NUMERIC: case INST_EXPAND_STKTOP: case INST_EXPR_STK: - objc = 1; - break; + objc = 1; + break; case INST_LIST_IN: case INST_LIST_NOT_IN: /* Basic list containment operators. */ @@ -747,22 +731,22 @@ TclGetInnerContext( case INST_SUB: case INST_DIV: case INST_MULT: - objc = 2; - break; + objc = 2; + break; case INST_RETURN_STK: - /* early pop. TODO: dig out opt dict too :/ */ - objc = 1; - break; + /* early pop. TODO: dig out opt dict too :/ */ + objc = 1; + break; case INST_SYNTAX: case INST_RETURN_IMM: - objc = 2; - break; + objc = 2; + break; case INST_INVOKE_STK4: objc = TclGetUInt4AtPtr(pc+1); - break; + break; case INST_INVOKE_STK1: objc = TclGetUInt1AtPtr(pc+1); @@ -771,37 +755,37 @@ TclGetInnerContext( result = iPtr->innerContext; if (Tcl_IsShared(result)) { - Tcl_DecrRefCount(result); - iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL); - Tcl_IncrRefCount(result); + Tcl_DecrRefCount(result); + iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL); + Tcl_IncrRefCount(result); } else { - Tcl_Size len; + Tcl_Size len; - /* - * Reset while keeping the list internalrep as much as possible. - */ + /* + * Reset while keeping the list internalrep as much as possible. + */ TclListObjLength(interp, result, &len); - Tcl_ListObjReplace(interp, result, 0, len, 0, NULL); + Tcl_ListObjReplace(interp, result, 0, len, 0, NULL); } Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc)); for (; objc>0 ; objc--) { - Tcl_Obj *objPtr; + Tcl_Obj *objPtr; - objPtr = tosPtr[1 - objc]; - if (!objPtr) { - Tcl_Panic("InnerContext: bad tos -- appending null object"); - } - if ((objPtr->refCount <= 0) + objPtr = tosPtr[1 - objc]; + if (!objPtr) { + Tcl_Panic("InnerContext: bad tos -- appending null object"); + } + if ((objPtr->refCount <= 0) #ifdef TCL_MEM_DEBUG - || (objPtr->refCount == 0x61616161) + || (objPtr->refCount == 0x61616161) #endif - ) { - Tcl_Panic("InnerContext: bad tos -- appending freed object %p", - objPtr); - } - Tcl_ListObjAppendElement(NULL, result, objPtr); + ) { + Tcl_Panic("InnerContext: bad tos -- appending freed object %p", + objPtr); + } + Tcl_ListObjAppendElement(NULL, result, objPtr); } return result; @@ -844,7 +828,7 @@ static void UpdateStringOfInstName( Tcl_Obj *objPtr) { - size_t inst; /* NOTE: We know this is really an unsigned char */ + size_t inst; /* NOTE: We know this is really an unsigned char */ char *dst; InstNameGetInternalRep(objPtr, inst); @@ -852,7 +836,7 @@ UpdateStringOfInstName( if (inst >= LAST_INST_OPCODE) { dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); TclOOM(dst, TCL_INTEGER_SPACE + 5); - snprintf(dst, TCL_INTEGER_SPACE + 5, "inst_%" TCL_Z_MODIFIER "u", inst); + snprintf(dst, TCL_INTEGER_SPACE + 5, "inst_%" TCL_Z_MODIFIER "u", inst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { const char *s = tclInstructionTable[inst].name; @@ -1187,8 +1171,8 @@ DisassembleByteCodeAsDicts( #define Decode(ptr) \ ((TclGetUInt1AtPtr(ptr) == 0xFF) \ - ? ((ptr)+=5, TclGetInt4AtPtr((ptr)-4)) \ - : ((ptr)+=1, TclGetInt1AtPtr((ptr)-1))) + ? ((ptr)+=5 , TclGetInt4AtPtr((ptr)-4)) \ + : ((ptr)+=1 , TclGetInt1AtPtr((ptr)-1))) TclNewObj(commands); codeOffPtr = codePtr->codeDeltaStart; @@ -1284,7 +1268,7 @@ DisassembleByteCodeAsDicts( int Tcl_DisassembleObjCmd( - void *clientData, /* What type of operation. */ + void *clientData, /* What type of operation. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 438a643..0844303 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -34,9 +34,9 @@ typedef struct { Tcl_EncodingFreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ - void *clientData; /* Arbitrary value associated with encoding + void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ - Tcl_Size nullSize; /* Number of 0x00 bytes that signify + Tcl_Size nullSize; /* Number of 0x00 bytes that signify * end-of-string in this encoding. This number * is used to determine the source string * length when the srcLen argument is @@ -201,19 +201,19 @@ static const struct TclEncodingProfiles { {"tcl8", TCL_ENCODING_PROFILE_TCL8}, }; -#define PROFILE_TCL8(flags) \ - (ENCODING_PROFILE_GET(flags) == TCL_ENCODING_PROFILE_TCL8) +#define PROFILE_TCL8(flags_) \ + (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8) -#define PROFILE_REPLACE(flags) \ - (ENCODING_PROFILE_GET(flags) == TCL_ENCODING_PROFILE_REPLACE) +#define PROFILE_REPLACE(flags_) \ + (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) -#define PROFILE_STRICT(flags) \ - (!PROFILE_TCL8(flags) && !PROFILE_REPLACE(flags)) +#define PROFILE_STRICT(flags_) \ + (!PROFILE_TCL8(flags_) && !PROFILE_REPLACE(flags_)) #define UNICODE_REPLACE_CHAR 0xFFFD -#define SURROGATE(chr) (((chr) & ~0x7FF) == 0xD800) -#define HIGH_SURROGATE(chr) (((chr) & ~0x3FF) == 0xD800) -#define LOW_SURROGATE(chr) (((chr) & ~0x3FF) == 0xDC00) +#define SURROGATE(c_) (((c_) & ~0x7FF) == 0xD800) +#define HIGH_SURROGATE(c_) (((c_) & ~0x3FF) == 0xD800) +#define LOW_SURROGATE(c_) (((c_) & ~0x3FF) == 0xDC00) /* * The following variable is used in the sparse matrix code for a @@ -924,7 +924,7 @@ Tcl_GetEncodingNames( * Tcl_GetEncodingNulLength -- * * Given an encoding, return the number of nul bytes used for the - * string termination. + * string termination. * * Results: * The number of nul bytes used for the string termination. @@ -1124,35 +1124,34 @@ Tcl_ExternalToUtfDString( * - *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT} * * Results: - * The return value is one of: - * - * TCL_OK: success. Converted string in *dstPtr - * TCL_ERROR: error in passed parameters. Error message in interp - * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence - * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition - * TCL_CONVERT_UNKNOWN: source contained a character that could not - * be represented in target encoding. + * The return value is one of + * TCL_OK: success. Converted string in *dstPtr + * TCL_ERROR: error in passed parameters. Error message in interp + * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence + * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition + * TCL_CONVERT_UNKNOWN: source contained a character that could not + * be represented in target encoding. * * Side effects: * - * TCL_OK: The converted bytes are stored in the DString and NUL - * terminated in an encoding-specific manner. - * TCL_ERROR: an error, message is stored in the interp if not NULL. - * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored - * in the interpreter (if not NULL). If errorLocPtr is not NULL, - * no error message is stored as it is expected the caller is - * interested in whatever is decoded so far and not treating this - * as an error condition. + * TCL_OK: The converted bytes are stored in the DString and NUL + * terminated in an encoding-specific manner. + * TCL_ERROR: an error, message is stored in the interp if not NULL. + * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored + * in the interpreter (if not NULL). If errorLocPtr is not NULL, + * no error message is stored as it is expected the caller is + * interested in whatever is decoded so far and not treating this + * as an error condition. * - * In addition, *dstPtr is always initialized and must be cleared - * by the caller irrespective of the return code. + * In addition, *dstPtr is always initialized and must be cleared + * by the caller irrespective of the return code. * *------------------------------------------------------------------------- */ int Tcl_ExternalToUtfDStringEx( - Tcl_Interp *interp, /* For error messages. May be NULL. */ + Tcl_Interp *interp, /* For error messages. May be NULL. */ Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ @@ -1161,8 +1160,8 @@ Tcl_ExternalToUtfDStringEx( int flags, /* Conversion control flags. */ Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ - Tcl_Size *errorLocPtr) /* Where to store the error location - * (or TCL_INDEX_NONE if no error). May + Tcl_Size *errorLocPtr) /* Where to store the error location + * (or TCL_INDEX_NONE if no error). May * be NULL. */ { char *dst; @@ -1441,35 +1440,34 @@ Tcl_UtfToExternalDString( * - *At most one* of TCL_ENCODING_PROFILE_* * * Results: - * The return value is one of: - * - * TCL_OK: success. Converted string in *dstPtr - * TCL_ERROR: error in passed parameters. Error message in interp - * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence - * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition - * TCL_CONVERT_UNKNOWN: source contained a character that could not - * be represented in target encoding. + * The return value is one of + * TCL_OK: success. Converted string in *dstPtr + * TCL_ERROR: error in passed parameters. Error message in interp + * TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence + * TCL_CONVERT_SYNTAX: source is not conformant to encoding definition + * TCL_CONVERT_UNKNOWN: source contained a character that could not + * be represented in target encoding. * * Side effects: * - * TCL_OK: The converted bytes are stored in the DString and NUL - * terminated in an encoding-specific manner - * TCL_ERROR: an error, message is stored in the interp if not NULL. - * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored - * in the interpreter (if not NULL). If errorLocPtr is not NULL, - * no error message is stored as it is expected the caller is - * interested in whatever is decoded so far and not treating this - * as an error condition. + * TCL_OK: The converted bytes are stored in the DString and NUL + * terminated in an encoding-specific manner + * TCL_ERROR: an error, message is stored in the interp if not NULL. + * TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored + * in the interpreter (if not NULL). If errorLocPtr is not NULL, + * no error message is stored as it is expected the caller is + * interested in whatever is decoded so far and not treating this + * as an error condition. * - * In addition, *dstPtr is always initialized and must be cleared - * by the caller irrespective of the return code. + * In addition, *dstPtr is always initialized and must be cleared + * by the caller irrespective of the return code. * *------------------------------------------------------------------------- */ int Tcl_UtfToExternalDStringEx( - Tcl_Interp *interp, /* For error messages. May be NULL. */ + Tcl_Interp *interp, /* For error messages. May be NULL. */ Tcl_Encoding encoding, /* The encoding for the converted string, or * NULL for the default system encoding. */ const char *src, /* Source string in UTF-8. */ @@ -1478,8 +1476,8 @@ Tcl_UtfToExternalDStringEx( int flags, /* Conversion control flags. */ Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ - Tcl_Size *errorLocPtr) /* Where to store the error location - * (or TCL_INDEX_NONE if no error). May + Tcl_Size *errorLocPtr) /* Where to store the error location + * (or TCL_INDEX_NONE if no error). May * be NULL. */ { char *dst; @@ -2460,6 +2458,7 @@ UtfToUtfProc( profile = ENCODING_PROFILE_GET(flags); for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { + if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the @@ -2473,8 +2472,7 @@ UtfToUtfProc( result = TCL_CONVERT_NOSPACE; break; } - if (UCHAR(*src) < 0x80 - && !((UCHAR(*src) == 0) && (flags & ENCODING_INPUT))) { + if (UCHAR(*src) < 0x80 && !((UCHAR(*src) == 0) && (flags & ENCODING_INPUT))) { /* * Copy 7bit characters, but skip null-bytes when we are in input * mode, so that they get converted to \xC0\x80. @@ -2515,8 +2513,8 @@ UtfToUtfProc( /* Incomplete bytes for modified UTF-8 target */ if (PROFILE_STRICT(profile)) { result = (flags & TCL_ENCODING_CHAR_LIMIT) - ? TCL_CONVERT_MULTIBYTE - : TCL_CONVERT_SYNTAX; + ? TCL_CONVERT_MULTIBYTE + : TCL_CONVERT_SYNTAX; break; } } @@ -2526,16 +2524,14 @@ UtfToUtfProc( } else { /* TCL_ENCODING_PROFILE_TCL8 */ char chbuf[2]; - chbuf[0] = UCHAR(*src++); - chbuf[1] = 0; + chbuf[0] = UCHAR(*src++); chbuf[1] = 0; TclUtfToUniChar(chbuf, &ch); } dst += Tcl_UniCharToUtf(ch, dst); } else { size_t len = TclUtfToUniChar(src, &ch); if (flags & ENCODING_INPUT) { - if (((len < 2) && (ch != 0)) - || ((ch > 0xFFFF) && !(flags & ENCODING_UTF))) { + if (((len < 2) && (ch != 0)) || ((ch > 0xFFFF) && !(flags & ENCODING_UTF))) { if (PROFILE_STRICT(profile)) { result = TCL_CONVERT_SYNTAX; break; @@ -2547,8 +2543,7 @@ UtfToUtfProc( const char *saveSrc = src; src += len; - if (!(flags & ENCODING_UTF) - && !(flags & ENCODING_INPUT) && (ch > 0x3FF)) { + if (!(flags & ENCODING_UTF) && !(flags & ENCODING_INPUT) && (ch > 0x3FF)) { if (ch > 0xFFFF) { /* CESU-8 6-byte sequence for chars > U+FFFF */ ch -= 0x10000; @@ -2563,9 +2558,7 @@ UtfToUtfProc( continue; } else if (SURROGATE(ch)) { if (PROFILE_STRICT(profile)) { - result = (flags & ENCODING_INPUT) - ? TCL_CONVERT_SYNTAX - : TCL_CONVERT_UNKNOWN; + result = (flags & ENCODING_INPUT) ? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN; src = saveSrc; break; } else if (PROFILE_REPLACE(profile)) { @@ -2600,7 +2593,7 @@ UtfToUtfProc( static int Utf32ToUtfProc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in Unicode. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -2729,7 +2722,7 @@ Utf32ToUtfProc( static int UtfToUtf32Proc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -2828,7 +2821,7 @@ UtfToUtf32Proc( static int Utf16ToUtfProc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in Unicode. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -2901,8 +2894,8 @@ Utf16ToUtfProc( if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) { if (PROFILE_STRICT(flags)) { result = TCL_CONVERT_SYNTAX; - src -= 2; /* Go back to beginning of high surrogate */ - dst--; /* Also undo writing a single byte too much */ + src -= 2; /* Go back to beginning of high surrogate */ + dst--; /* Also undo writing a single byte too much */ numChars--; break; } else if (PROFILE_REPLACE(flags)) { @@ -2919,8 +2912,7 @@ Utf16ToUtfProc( numChars--; continue; } else { - /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo - * surrogate, finish 3-byte UTF-8 */ + /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */ dst += Tcl_UniCharToUtf(-1, dst); } } @@ -3007,7 +2999,7 @@ Utf16ToUtfProc( static int UtfToUtf16Proc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -3115,7 +3107,7 @@ UtfToUtf16Proc( static int UtfToUcs2Proc( - void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ + void *clientData, /* additional flags, e.g. TCL_ENCODING_LE */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ @@ -3219,7 +3211,7 @@ UtfToUcs2Proc( static int TableToUtfProc( - void *clientData, /* TableEncodingData that specifies + void *clientData, /* TableEncodingData that specifies * encoding. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ @@ -3304,8 +3296,7 @@ TableToUtfProc( ch = UNICODE_REPLACE_CHAR; } else { char chbuf[2]; - chbuf[0] = byte; - chbuf[1] = 0; + chbuf[0] = byte; chbuf[1] = 0; TclUtfToUniChar(chbuf, &ch); } } @@ -3348,7 +3339,7 @@ TableToUtfProc( static int TableFromUtfProc( - void *clientData, /* TableEncodingData that specifies + void *clientData, /* TableEncodingData that specifies * encoding. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ @@ -3640,7 +3631,7 @@ Iso88591FromUtfProc( static void TableFreeProc( - void *clientData) /* TableEncodingData that specifies + void *clientData) /* TableEncodingData that specifies * encoding. */ { TableEncodingData *dataPtr = (TableEncodingData *)clientData; @@ -3675,7 +3666,7 @@ TableFreeProc( static int EscapeToUtfProc( - void *clientData, /* EscapeEncodingData that specifies + void *clientData, /* EscapeEncodingData that specifies * encoding. */ const char *src, /* Source string in specified encoding. */ int srcLen, /* Source string length in bytes. */ @@ -3888,7 +3879,7 @@ EscapeToUtfProc( static int EscapeFromUtfProc( - void *clientData, /* EscapeEncodingData that specifies + void *clientData, /* EscapeEncodingData that specifies * encoding. */ const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ @@ -4099,7 +4090,7 @@ EscapeFromUtfProc( static void EscapeFreeProc( - void *clientData) /* EscapeEncodingData that specifies + void *clientData) /* EscapeEncodingData that specifies * encoding. */ { EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData; diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 94dca96..1ff0921 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -85,7 +85,7 @@ static const Tcl_ObjType ensembleCmdType = { TCL_OBJTYPE_V0 }; -#define ECRSetInternalRep(objPtr, ecRepPtr) \ +#define ECRSetInternalRep(objPtr, ecRepPtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (ecRepPtr); \ @@ -93,11 +93,11 @@ static const Tcl_ObjType ensembleCmdType = { Tcl_StoreInternalRep((objPtr), &ensembleCmdType, &ir); \ } while (0) -#define ECRGetInternalRep(objPtr, ecRepPtr) \ +#define ECRGetInternalRep(objPtr, ecRepPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &ensembleCmdType); \ - (ecRepPtr) = irPtr ? (EnsembleCmdRep *)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &ensembleCmdType); \ + (ecRepPtr) = irPtr ? (EnsembleCmdRep *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -106,14 +106,14 @@ static const Tcl_ObjType ensembleCmdType = { */ typedef struct { - Tcl_Size epoch; /* Used to confirm when the data in this - * really structure matches up with the - * ensemble. */ - Command *token; /* Reference to the command for which this - * structure is a cache of the resolution. */ - Tcl_Obj *fix; /* Corrected spelling, if needed. */ - Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash - * table. */ + Tcl_Size epoch; /* Used to confirm when the data in this + * really structure matches up with the + * ensemble. */ + Command *token; /* Reference to the command for which this + * structure is a cache of the resolution. */ + Tcl_Obj *fix; /* Corrected spelling, if needed. */ + Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash + * table. */ } EnsembleCmdRep; static inline Tcl_Obj * @@ -529,7 +529,7 @@ TclNamespaceEnsembleCmd( for (; objc>0 ; objc-=2,objv+=2) { enum EnsConfigOpts idx; - if (Tcl_GetIndexFromObj(interp, objv[0], ensembleConfigOptions, + if (Tcl_GetIndexFromObj(interp, objv[0],ensembleConfigOptions, "option", 0, &idx) != TCL_OK) { freeMapAndError: if (allocatedMapFlag) { @@ -2484,15 +2484,15 @@ ClearTable( Tcl_HashTable *hash = &ensemblePtr->subcommandTable; if (hash->numEntries != 0) { - Tcl_HashSearch search; - Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search); + Tcl_HashSearch search; + Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search); - while (hPtr != NULL) { - Tcl_Obj *prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(prefixObj); - hPtr = Tcl_NextHashEntry(&search); - } - Tcl_Free(ensemblePtr->subcommandArrayPtr); + while (hPtr != NULL) { + Tcl_Obj *prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); + Tcl_DecrRefCount(prefixObj); + hPtr = Tcl_NextHashEntry(&search); + } + Tcl_Free(ensemblePtr->subcommandArrayPtr); } Tcl_DeleteHashTable(hash); } @@ -2595,100 +2595,100 @@ BuildEnsembleConfig( Tcl_InitHashTable(hash, TCL_STRING_KEYS); if (subList) { - Tcl_Size subc; - Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; - const char *name; - - /* - * There is a list of exactly what subcommands go in the table. - * Determine the target for each. - */ - - TclListObjGetElements(NULL, subList, &subc, &subv); - if (subList == mapDict) { - /* - * Unusual case where explicit list of subcommands is same value - * as the dict mapping to targets. - */ - - for (i = 0; i < subc; i += 2) { - name = TclGetString(subv[i]); - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - if (!isNew) { - cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(cmdObj); - } - Tcl_SetHashValue(hPtr, subv[i+1]); - Tcl_IncrRefCount(subv[i+1]); - - name = TclGetString(subv[i+1]); - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - if (isNew) { - cmdObj = Tcl_NewStringObj(name, -1); - cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); - Tcl_SetHashValue(hPtr, cmdPrefixObj); - Tcl_IncrRefCount(cmdPrefixObj); - } - } - } else { - /* + Tcl_Size subc; + Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; + const char *name; + + /* + * There is a list of exactly what subcommands go in the table. + * Determine the target for each. + */ + + TclListObjGetElements(NULL, subList, &subc, &subv); + if (subList == mapDict) { + /* + * Unusual case where explicit list of subcommands is same value + * as the dict mapping to targets. + */ + + for (i = 0; i < subc; i += 2) { + name = TclGetString(subv[i]); + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + if (!isNew) { + cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr); + Tcl_DecrRefCount(cmdObj); + } + Tcl_SetHashValue(hPtr, subv[i+1]); + Tcl_IncrRefCount(subv[i+1]); + + name = TclGetString(subv[i+1]); + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + if (isNew) { + cmdObj = Tcl_NewStringObj(name, -1); + cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); + Tcl_SetHashValue(hPtr, cmdPrefixObj); + Tcl_IncrRefCount(cmdPrefixObj); + } + } + } else { + /* * Usual case where we can freely act on the list and dict. */ - for (i = 0; i < subc; i++) { - name = TclGetString(subv[i]); - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - if (!isNew) { - continue; - } + for (i = 0; i < subc; i++) { + name = TclGetString(subv[i]); + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + if (!isNew) { + continue; + } - /* + /* * Lookup target in the dictionary. */ - if (mapDict) { - Tcl_DictObjGet(NULL, mapDict, subv[i], &target); - if (target) { - Tcl_SetHashValue(hPtr, target); - Tcl_IncrRefCount(target); - continue; - } - } - - /* - * Target was not in the dictionary. Map onto the namespace. - * In this case there is no guarantee that the command - * is actually there. It is the responsibility of the + if (mapDict) { + Tcl_DictObjGet(NULL, mapDict, subv[i], &target); + if (target) { + Tcl_SetHashValue(hPtr, target); + Tcl_IncrRefCount(target); + continue; + } + } + + /* + * Target was not in the dictionary. Map onto the namespace. + * In this case there is no guarantee that the command + * is actually there. It is the responsibility of the * programmer (or [::unknown] of course) to provide the procedure. - */ - - cmdObj = Tcl_NewStringObj(name, -1); - cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); - Tcl_SetHashValue(hPtr, cmdPrefixObj); - Tcl_IncrRefCount(cmdPrefixObj); - } - } + */ + + cmdObj = Tcl_NewStringObj(name, -1); + cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); + Tcl_SetHashValue(hPtr, cmdPrefixObj); + Tcl_IncrRefCount(cmdPrefixObj); + } + } } else if (mapDict) { - /* - * No subcmd list, but there is a mapping dictionary, so - * use the keys of that. Convert the contents of the dictionary into the - * form required for the internal hashtable of the ensemble. - */ - - Tcl_DictSearch dictSearch; - Tcl_Obj *keyObj, *valueObj; - int done; - - Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, - &keyObj, &valueObj, &done); - while (!done) { - const char *name = TclGetString(keyObj); - - hPtr = Tcl_CreateHashEntry(hash, name, &isNew); - Tcl_SetHashValue(hPtr, valueObj); - Tcl_IncrRefCount(valueObj); - Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done); - } + /* + * No subcmd list, but there is a mapping dictionary, so + * use the keys of that. Convert the contents of the dictionary into the + * form required for the internal hashtable of the ensemble. + */ + + Tcl_DictSearch dictSearch; + Tcl_Obj *keyObj, *valueObj; + int done; + + Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, + &keyObj, &valueObj, &done); + while (!done) { + const char *name = TclGetString(keyObj); + + hPtr = Tcl_CreateHashEntry(hash, name, &isNew); + Tcl_SetHashValue(hPtr, valueObj); + Tcl_IncrRefCount(valueObj); + Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done); + } } else { /* * Use the array of patterns and the hash table whose keys are the @@ -3011,7 +3011,7 @@ TclCompileEnsemble( * Exact match! Excellent! */ - result = Tcl_DictObjGet(NULL, mapObj, elems[i], &targetCmdObj); + result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj); if (result != TCL_OK || targetCmdObj == NULL) { goto tryCompileToInv; } @@ -3193,9 +3193,9 @@ TclCompileEnsemble( */ while (mapPtr->nuloc > eclIndex + 1) { - mapPtr->nuloc--; - Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); - mapPtr->loc[mapPtr->nuloc].line = NULL; + mapPtr->nuloc--; + Tcl_Free(mapPtr->loc[mapPtr->nuloc].line); + mapPtr->loc[mapPtr->nuloc].line = NULL; } /* @@ -3451,7 +3451,7 @@ CompileToInvokedCommand( * Do the replacing dispatch. */ - TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords, numWords+1); + TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1); } /* diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 4ef7b24..0128672 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -19,13 +19,10 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #if defined(_WIN32) # define tenviron _wenviron -# define tenviron2utfdstr(str, dsPtr) \ - (Tcl_DStringInit(dsPtr), \ - (char *)Tcl_Char16ToUtfDString( \ - (const unsigned short *)(str), -1, (dsPtr))) -# define utf2tenvirondstr(str, dsPtr) \ - (Tcl_DStringInit(dsPtr), \ - (const WCHAR *) Tcl_UtfToChar16DString((str), -1, (dsPtr))) +# define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ + (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr))) +# define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ + (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr))) # define techar WCHAR # ifdef USE_PUTENV # define putenv(env) _wputenv((const wchar_t *)env) @@ -40,7 +37,7 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #endif /* MODULE_SCOPE */ -size_t TclEnvEpoch = 0; /* Epoch of the tcl environment +size_t TclEnvEpoch = 0; /* Epoch of the tcl environment * (if changed with tcl-env). */ static struct { @@ -48,7 +45,7 @@ static struct { char **cache; /* Array containing all of the environment * strings that Tcl has allocated. */ #ifndef USE_PUTENV - techar **ourEnviron; /* Cache of the array that we allocate. We + techar **ourEnviron; /* Cache of the array that we allocate. We * need to track this in case another * subsystem swaps around the environ array * like we do. */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index de475ea..29d8a0c 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -69,7 +69,7 @@ typedef struct { typedef struct ExitHandler { Tcl_ExitProc *proc; /* Function to call when process exits. */ - void *clientData; /* One word of information to pass to proc. */ + void *clientData; /* One word of information to pass to proc. */ struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this * application, or NULL for end of list. */ } ExitHandler; @@ -119,7 +119,7 @@ static Tcl_ThreadDataKey dataKey; #if TCL_THREADS typedef struct { Tcl_ThreadCreateProc *proc; /* Main() function of the thread */ - void *clientData; /* The one argument to Main() */ + void *clientData; /* The one argument to Main() */ } ThreadClientData; static Tcl_ThreadCreateType NewThreadProc(void *clientData); #endif /* TCL_THREADS */ @@ -209,7 +209,7 @@ Tcl_BackgroundException( static void HandleBgErrors( - void *clientData) /* Pointer to ErrAssocData structure. */ + void *clientData) /* Pointer to ErrAssocData structure. */ { ErrAssocData *assocPtr = (ErrAssocData *)clientData; Tcl_Interp *interp = assocPtr->interp; @@ -613,7 +613,7 @@ TclGetBgErrorHandler( static void BgErrorDeleteProc( - void *clientData, /* Pointer to ErrAssocData structure. */ + void *clientData, /* Pointer to ErrAssocData structure. */ TCL_UNUSED(Tcl_Interp *)) { ErrAssocData *assocPtr = (ErrAssocData *)clientData; @@ -652,7 +652,7 @@ BgErrorDeleteProc( void Tcl_CreateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler)); @@ -685,7 +685,7 @@ Tcl_CreateExitHandler( void TclCreateLateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler)); @@ -718,7 +718,7 @@ TclCreateLateExitHandler( void Tcl_DeleteExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; @@ -761,7 +761,7 @@ Tcl_DeleteExitHandler( void TclDeleteLateExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; @@ -804,7 +804,7 @@ TclDeleteLateExitHandler( void Tcl_CreateThreadExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -837,7 +837,7 @@ Tcl_CreateThreadExitHandler( void Tcl_DeleteThreadExitHandler( Tcl_ExitProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -899,14 +899,14 @@ Tcl_SetExitProc( * * InvokeExitHandlers -- * - * Call the registered exit handlers. + * Call the registered exit handlers. * * Results: * None. * * Side effects: - * The exit handlers are invoked, and the Exi tHandler struct is - * freed. + * The exit handlers are invoked, and the ExitHandler struct is + * freed. * *---------------------------------------------------------------------- */ @@ -1132,13 +1132,14 @@ Tcl_InitSubsystems(void) TclpInitLock(); if (subsystemsInitialized == 0) { - /* + + /* * Initialize locks used by the memory allocators before anything * interesting happens so we can use the allocators in the * implementation of self-initializing locks. */ - TclInitThreadStorage(); /* Creates hash table for + TclInitThreadStorage(); /* Creates hash table for * thread local storage */ #if defined(USE_TCLALLOC) && USE_TCLALLOC TclInitAlloc(); /* Process wide mutex init */ @@ -2051,7 +2052,7 @@ Tcl_CreateThread( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ void *clientData, /* The one argument to Main() */ - size_t stackSize, /* Size of stack for the new thread */ + size_t stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 8ded940..b12162c 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -918,8 +918,8 @@ FileBasename( Tcl_IncrRefCount(splitPtr); if (objc != 0) { - /* - * Return the last component, unless it is the only component, and it + /* + * Return the last component, unless it is the only component, and it * is the root of an absolute path. */ @@ -1115,7 +1115,7 @@ TclFileAttrsCmd( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\", there are no file attributes in this" " filesystem", TclGetString(objv[0]))); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR", "NONE", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (void *)NULL); goto end; } @@ -1139,7 +1139,7 @@ TclFileAttrsCmd( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\", there are no file attributes in this" " filesystem", TclGetString(objv[0]))); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR", "NONE", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (void *)NULL); goto end; } @@ -1519,7 +1519,7 @@ TclFileTemporaryCmd( */ makeTemporary: - chan = TclpOpenTemporaryFile(tempDirObj, tempBaseObj, tempExtObj, nameObj); + chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj); /* * If we created pieces of template, get rid of them now. diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 9ef5b92..c99244c 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -348,7 +348,7 @@ Tcl_GetPathType( const char *path) { Tcl_PathType type; - Tcl_Obj *tempObj = Tcl_NewStringObj(path, -1); + Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1); Tcl_IncrRefCount(tempObj); type = Tcl_FSGetPathType(tempObj); @@ -381,9 +381,8 @@ Tcl_GetPathType( Tcl_PathType TclpGetNativePathType( Tcl_Obj *pathPtr, /* Native path of interest */ - Tcl_Size *driveNameLengthPtr, - /* Returns length of drive, if non-NULL and - * path was absolute */ + Tcl_Size *driveNameLengthPtr, /* Returns length of drive, if non-NULL and + * path was absolute */ Tcl_Obj **driveNameRef) { Tcl_PathType type = TCL_PATH_ABSOLUTE; @@ -391,50 +390,50 @@ TclpGetNativePathType( switch (tclPlatform) { case TCL_PLATFORM_UNIX: { - const char *origPath = path; - - /* - * Paths that begin with / are absolute. - */ - - if (path[0] == '/') { - ++path; - /* - * Check for "//" network path prefix - */ - if ((*path == '/') && path[1] && (path[1] != '/')) { - path += 2; - while (*path && *path != '/') { - ++path; - } - } - if (driveNameLengthPtr != NULL) { - /* - * We need this addition in case the "//" code was used. - */ - - *driveNameLengthPtr = (path - origPath); - } - } else { - type = TCL_PATH_RELATIVE; - } - break; + const char *origPath = path; + + /* + * Paths that begin with / are absolute. + */ + + if (path[0] == '/') { + ++path; + /* + * Check for "//" network path prefix + */ + if ((*path == '/') && path[1] && (path[1] != '/')) { + path += 2; + while (*path && *path != '/') { + ++path; + } + } + if (driveNameLengthPtr != NULL) { + /* + * We need this addition in case the "//" code was used. + */ + + *driveNameLengthPtr = (path - origPath); + } + } else { + type = TCL_PATH_RELATIVE; + } + break; } case TCL_PLATFORM_WINDOWS: { - Tcl_DString ds; - const char *rootEnd; - - Tcl_DStringInit(&ds); - rootEnd = ExtractWinRoot(path, &ds, 0, &type); - if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { - *driveNameLengthPtr = rootEnd - path; - if (driveNameRef != NULL) { - *driveNameRef = Tcl_DStringToObj(&ds); - Tcl_IncrRefCount(*driveNameRef); - } - } - Tcl_DStringFree(&ds); - break; + Tcl_DString ds; + const char *rootEnd; + + Tcl_DStringInit(&ds); + rootEnd = ExtractWinRoot(path, &ds, 0, &type); + if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { + *driveNameLengthPtr = rootEnd - path; + if (driveNameRef != NULL) { + *driveNameRef = Tcl_DStringToObj(&ds); + Tcl_IncrRefCount(*driveNameRef); + } + } + Tcl_DStringFree(&ds); + break; } } return type; @@ -655,8 +654,9 @@ SplitUnixPath( } length = path - elementStart; if (length > 0) { - Tcl_Obj *nextElt = Tcl_NewStringObj(elementStart, length); - Tcl_ListObjAppendElement(NULL, result, nextElt); + Tcl_Obj *nextElt; + nextElt = Tcl_NewStringObj(elementStart, length); + Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*path++ == '\0') { break; @@ -980,8 +980,8 @@ Tcl_JoinPath( * * Results: * The return value is a pointer to a string containing the name. - * This may either be the name pointer passed in or space allocated in - * bufferPtr. In all cases, if the return value is not NULL, the caller + * This may either be the name pointer passed in or space allocated in + * bufferPtr. In all cases, if the return value is not NULL, the caller * must call Tcl_DStringFree() to free the space. If there was an * error in processing the name, then an error message is left in the * interp's result (if interp was not NULL) and the return value is NULL. @@ -1132,7 +1132,7 @@ Tcl_GlobObjCmd( GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS, GLOB_TYPE, GLOB_LAST } index; - enum pathDirOptions {PATH_NONE = -1, PATH_GENERAL = 0, PATH_DIR = 1}; + enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1}; Tcl_GlobTypeData *globTypes = NULL; globFlags = 0; @@ -1193,7 +1193,7 @@ Tcl_GlobObjCmd( case GLOB_JOIN: /* -join */ join = 1; break; - case GLOB_TAILS: /* -tails */ + case GLOB_TAILS: /* -tails */ globFlags |= TCL_GLOBMODE_TAILS; break; case GLOB_PATH: /* -path */ @@ -1259,7 +1259,7 @@ Tcl_GlobObjCmd( if (dir == PATH_GENERAL) { Tcl_Size pathlength; const char *last; - const char *first = TclGetStringFromObj(pathOrDir, &pathlength); + const char *first = TclGetStringFromObj(pathOrDir,&pathlength); /* * Find the last path separator in the path @@ -2255,7 +2255,7 @@ DoGlob( */ Tcl_Size len; - const char *joined = TclGetStringFromObj(joinedPtr, &len); + const char *joined = TclGetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { Tcl_AppendToObj(joinedPtr, "/", 1); @@ -2292,7 +2292,7 @@ DoGlob( */ Tcl_Size len; - const char *joined = TclGetStringFromObj(joinedPtr, &len); + const char *joined = TclGetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) { diff --git a/generic/tclHash.c b/generic/tclHash.c index 630f8c9..89807e2 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -60,30 +60,30 @@ static Tcl_HashEntry * FindHashEntry(Tcl_HashTable *tablePtr, const char *key); static void RebuildTable(Tcl_HashTable *tablePtr); const Tcl_HashKeyType tclArrayHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ - TCL_HASH_KEY_RANDOMIZE_HASH,/* flags */ - HashArrayKey, /* hashKeyProc */ - CompareArrayKeys, /* compareKeysProc */ - AllocArrayEntry, /* allocEntryProc */ - NULL /* freeEntryProc */ + TCL_HASH_KEY_TYPE_VERSION, /* version */ + TCL_HASH_KEY_RANDOMIZE_HASH, /* flags */ + HashArrayKey, /* hashKeyProc */ + CompareArrayKeys, /* compareKeysProc */ + AllocArrayEntry, /* allocEntryProc */ + NULL /* freeEntryProc */ }; const Tcl_HashKeyType tclOneWordHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ - 0, /* flags */ - NULL, /* HashOneWordKey, */ /* hashProc */ - NULL, /* CompareOneWordKey, * compareProc */ - NULL, /* AllocOneWordKey, *//* allocEntryProc */ - NULL /* FreeOneWordKey, */ /* freeEntryProc */ + TCL_HASH_KEY_TYPE_VERSION, /* version */ + 0, /* flags */ + NULL, /* HashOneWordKey, */ /* hashProc */ + NULL, /* CompareOneWordKey, */ /* compareProc */ + NULL, /* AllocOneWordKey, */ /* allocEntryProc */ + NULL /* FreeOneWordKey, */ /* freeEntryProc */ }; const Tcl_HashKeyType tclStringHashKeyType = { - TCL_HASH_KEY_TYPE_VERSION, /* version */ - 0, /* flags */ - HashStringKey, /* hashKeyProc */ - CompareStringKeys, /* compareKeysProc */ - AllocStringEntry, /* allocEntryProc */ - NULL /* freeEntryProc */ + TCL_HASH_KEY_TYPE_VERSION, /* version */ + 0, /* flags */ + HashStringKey, /* hashKeyProc */ + CompareStringKeys, /* compareKeysProc */ + AllocStringEntry, /* allocEntryProc */ + NULL /* freeEntryProc */ }; /* @@ -106,7 +106,8 @@ const Tcl_HashKeyType tclStringHashKeyType = { void Tcl_InitHashTable( - Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied + 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 @@ -143,14 +144,14 @@ Tcl_InitHashTable( void Tcl_InitCustomHashTable( - Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied + 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 + const Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the * behaviour of this table. */ { #if (TCL_SMALL_HASH_TABLE != 4) @@ -284,7 +285,7 @@ CreateHashEntry( } /* if keys pointers or values are equal */ if ((key == hPtr->key.oneWordValue) - || compareKeysProc((void *) key, hPtr)) { + || compareKeysProc((void *) key, hPtr)) { if (newPtr) { *newPtr = 0; } @@ -555,7 +556,8 @@ Tcl_FirstHashEntry( Tcl_HashEntry * Tcl_NextHashEntry( - Tcl_HashSearch *searchPtr) /* Place to store information about progress + Tcl_HashSearch *searchPtr) + /* Place to store information about progress * through the table. Must have been * initialized by calling * Tcl_FirstHashEntry. */ @@ -669,7 +671,7 @@ Tcl_HashStats( static Tcl_HashEntry * AllocArrayEntry( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key to store in the hash table entry. */ + void *keyPtr) /* Key to store in the hash table entry. */ { Tcl_HashEntry *hPtr; size_t count = tablePtr->keyType * sizeof(int); @@ -705,7 +707,7 @@ AllocArrayEntry( static int CompareArrayKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { size_t count = hPtr->tablePtr->keyType * sizeof(int); @@ -734,7 +736,7 @@ CompareArrayKeys( static size_t HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key from which to compute hash value. */ + void *keyPtr) /* Key from which to compute hash value. */ { const int *array = (const int *) keyPtr; size_t result; @@ -766,7 +768,7 @@ HashArrayKey( static Tcl_HashEntry * AllocStringEntry( TCL_UNUSED(Tcl_HashTable *), - void *keyPtr) /* Key to store in the hash table entry. */ + void *keyPtr) /* Key to store in the hash table entry. */ { const char *string = (const char *) keyPtr; Tcl_HashEntry *hPtr; @@ -802,7 +804,7 @@ AllocStringEntry( static int CompareStringKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { return !strcmp((char *)keyPtr, hPtr->key.string); @@ -828,7 +830,7 @@ CompareStringKeys( static size_t HashStringKey( TCL_UNUSED(Tcl_HashTable *), - void *keyPtr) /* Key from which to compute hash value. */ + void *keyPtr) /* Key from which to compute hash value. */ { const char *string = (const char *)keyPtr; size_t result; diff --git a/generic/tclIO.c b/generic/tclIO.c index 59bf248..eec6062 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -230,12 +230,12 @@ static Tcl_Size Write(Channel *chanPtr, const char *src, static Tcl_Obj * FixLevelCode(Tcl_Obj *msg); static void SpliceChannel(Tcl_Channel chan); static void CutChannel(Tcl_Channel chan); -static int WillRead(Channel *chanPtr); +static int WillRead(Channel *chanPtr); #define WriteChars(chanPtr, src, srcLen) \ - Write(chanPtr, src, srcLen, chanPtr->state->encoding) + Write(chanPtr, src, srcLen, chanPtr->state->encoding) #define WriteBytes(chanPtr, src, srcLen) \ - Write(chanPtr, src, srcLen, tclIdentityEncoding) + Write(chanPtr, src, srcLen, tclIdentityEncoding) /* * Simplifying helper macros. All may use their argument(s) multiple times. @@ -313,7 +313,7 @@ static int WillRead(Channel *chanPtr); */ #define HaveOpt(minLength, nameString) \ - ((len > (minLength)) && (optionName[1] == (nameString)[1]) \ + ((len > (minLength)) && (optionName[1] == (nameString)[1]) \ && (strncmp(optionName, (nameString), len) == 0)) /* @@ -335,32 +335,35 @@ static void FreeChannelInternalRep(Tcl_Obj *objPtr); static const Tcl_ObjType chanObjType = { "channel", /* name for this type */ - FreeChannelInternalRep, /* freeIntRepProc */ - DupChannelInternalRep, /* dupIntRepProc */ + FreeChannelInternalRep, /* freeIntRepProc */ + DupChannelInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; -#define ChanSetInternalRep(objPtr, resPtr) \ +#define GetIso88591() \ + (binaryEncoding ? Tcl_GetEncoding(NULL, "iso8859-1") : binaryEncoding) + +#define ChanSetInternalRep(objPtr, resPtr) \ do { \ Tcl_ObjInternalRep ir; \ (resPtr)->refCount++; \ ir.twoPtrValue.ptr1 = (resPtr); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &chanObjType, &ir); \ + Tcl_StoreInternalRep((objPtr), &chanObjType, &ir); \ } while (0) -#define ChanGetInternalRep(objPtr, resPtr) \ +#define ChanGetInternalRep(objPtr, resPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &chanObjType); \ - (resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL; \ + (resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) -#define BUSY_STATE(statePtr, flags) \ - ((((statePtr)->csPtrR) && ((flags) & TCL_READABLE)) || \ - (((statePtr)->csPtrW) && ((flags) & TCL_WRITABLE))) +#define BUSY_STATE(st, fl) \ + ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ + (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) #define MAX_CHANNEL_BUFFER_SIZE (1024*1024) @@ -846,7 +849,7 @@ Tcl_CreateCloseHandler( * callback. */ Tcl_CloseProc *proc, /* The callback routine to call when the * channel will be closed. */ - void *clientData) /* Arbitrary data to pass to the close + void *clientData) /* Arbitrary data to pass to the close * callback. */ { ChannelState *statePtr = ((Channel *) chan)->state; @@ -884,7 +887,7 @@ Tcl_DeleteCloseHandler( * callback. */ Tcl_CloseProc *proc, /* The procedure for the callback to * remove. */ - void *clientData) /* The callback data for the callback to + void *clientData) /* The callback data for the callback to * remove. */ { ChannelState *statePtr = ((Channel *) chan)->state; @@ -983,7 +986,7 @@ GetChannelTable( static void DeleteChannelTable( - void *clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { Tcl_HashTable *hTblPtr; /* The hash table. */ @@ -1593,10 +1596,9 @@ TclGetChannelFromObj( Tcl_Channel Tcl_CreateChannel( - const Tcl_ChannelType *typePtr, - /* The channel type record. */ + const Tcl_ChannelType *typePtr, /* The channel type record. */ const char *chanName, /* Name of channel to record. */ - void *instanceData, /* Instance specific data. */ + void *instanceData, /* Instance specific data. */ int mask) /* TCL_READABLE & TCL_WRITABLE to indicate if * the channel is readable, writable. */ { @@ -1806,7 +1808,7 @@ Tcl_StackChannel( const Tcl_ChannelType *typePtr, /* The channel type record for the new * channel. */ - void *instanceData, /* Instance specific data for the new + void *instanceData, /* Instance specific data for the new * channel. */ int mask, /* TCL_READABLE & TCL_WRITABLE to indicate if * the channel is readable, writable. */ @@ -2404,7 +2406,7 @@ int Tcl_GetChannelHandle( Tcl_Channel chan, /* The channel to get file from. */ int direction, /* TCL_WRITABLE or TCL_READABLE. */ - void **handlePtr) /* Where to store handle */ + void **handlePtr) /* Where to store handle */ { Channel *chanPtr; /* The actual channel. */ void *handle; @@ -2444,10 +2446,9 @@ Tcl_GetChannelHandle( int Tcl_RemoveChannelMode( - Tcl_Interp *interp, /* The interp for an error message. Allowed to - * be NULL. */ - Tcl_Channel chan, /* The channel which is modified. */ - int mode) /* The access mode to drop from the channel */ + Tcl_Interp *interp, /* The interp for an error message. Allowed to be NULL. */ + Tcl_Channel chan, /* The channel which is modified. */ + int mode) /* The access mode to drop from the channel */ { const char* emsg; ChannelState *statePtr = ((Channel *) chan)->state; @@ -2500,7 +2501,7 @@ Tcl_RemoveChannelMode( static ChannelBuffer * AllocChannelBuffer( - Tcl_Size length) /* Desired length of channel buffer. */ + Tcl_Size length) /* Desired length of channel buffer. */ { ChannelBuffer *bufPtr; Tcl_Size n; @@ -3423,7 +3424,7 @@ TclClose( * channel. */ Channel *chanPtr; /* The real IO channel. */ ChannelState *statePtr; /* State of real IO channel. */ - int result = 0; /* Of calling FlushChannel. */ + int result = 0; /* Of calling FlushChannel. */ int flushcode; int stickyError; @@ -4040,8 +4041,8 @@ Tcl_Size Tcl_Write( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* Data to queue in output buffer. */ - Tcl_Size srcLen) /* Length of data in bytes, or TCL_INDEX_NONE - * for strlen(). */ + Tcl_Size srcLen) /* Length of data in bytes, or TCL_INDEX_NONE for + * strlen(). */ { /* * Always use the topmost channel of the stack @@ -4152,8 +4153,8 @@ Tcl_WriteChars( Tcl_Channel chan, /* The channel to buffer output for. */ const char *src, /* UTF-8 characters to queue in output * buffer. */ - Tcl_Size len) /* Length of string in bytes, or TCL_INDEX_NONE - * for strlen(). */ + Tcl_Size len) /* Length of string in bytes, or TCL_INDEX_NONE for + * strlen(). */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ @@ -5213,10 +5214,10 @@ TclGetsObjBinary( /* * Convert the buffer if there was an encoding. + * XXX - unimplemented. */ if (statePtr->encoding != GetBinaryEncoding()) { - // XXX - unimplemented! } /* @@ -5693,7 +5694,7 @@ Tcl_Size Tcl_Read( Tcl_Channel chan, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ + Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; @@ -5738,7 +5739,7 @@ Tcl_Size Tcl_ReadRaw( Tcl_Channel chan, /* The channel from which to read. */ char *readBuf, /* Where to store input read. */ - Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ + Tcl_Size bytesToRead) /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; @@ -6789,7 +6790,7 @@ Tcl_Size Tcl_Ungets( Tcl_Channel chan, /* The channel for which to add the input. */ const char *str, /* The input itself. */ - Tcl_Size len, /* The length of the input. */ + Tcl_Size len, /* The length of the input. */ int atEnd) /* If non-zero, add at end of queue; otherwise * add at head of queue. */ { @@ -7734,7 +7735,7 @@ Tcl_ChannelBuffered( void Tcl_SetChannelBufferSize( Tcl_Channel chan, /* The channel whose buffer size to set. */ - Tcl_Size sz) /* The size to set. */ + Tcl_Size sz) /* The size to set. */ { ChannelState *statePtr; /* State of real channel structure. */ @@ -8715,7 +8716,7 @@ UpdateInterest( TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc, chanPtr); + ChannelTimerProc,chanPtr); } ChanWatch(chanPtr, mask); @@ -8765,7 +8766,7 @@ ChannelTimerProc( * before UpdateInterest gets called by Tcl_NotifyChannel. */ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc, chanPtr); + ChannelTimerProc,chanPtr); Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE); } else { /* The channel may have just been closed from within Tcl_NotifyChannel */ @@ -8780,7 +8781,7 @@ ChannelTimerProc( */ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc, chanPtr); + ChannelTimerProc,chanPtr); Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); } else { CleanupTimerHandler(statePtr); @@ -8843,7 +8844,7 @@ Tcl_CreateChannelHandler( * handler. */ Tcl_ChannelProc *proc, /* Procedure to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ChannelHandler *chPtr; Channel *chanPtr = (Channel *) chan; @@ -8915,7 +8916,7 @@ Tcl_DeleteChannelHandler( Tcl_Channel chan, /* The channel for which to remove the * callback. */ Tcl_ChannelProc *proc, /* The procedure in the callback to delete. */ - void *clientData) /* The client data in the callback to + void *clientData) /* The client data in the callback to * delete. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -9121,7 +9122,7 @@ CreateScriptRecord( void TclChannelEventScriptInvoker( - void *clientData, /* The script+interp record. */ + void *clientData, /* The script+interp record. */ TCL_UNUSED(int) /*mask*/) { EventScriptRecord *esPtr = (EventScriptRecord *)clientData; @@ -9758,11 +9759,11 @@ CopyData( if (moveBytes) { size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb, - !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); + !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); } else { size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, - !GotFlag(inStatePtr, CHANNEL_NONBLOCKING), - 0 /* No append */); + !GotFlag(inStatePtr, CHANNEL_NONBLOCKING) + ,0 /* No append */); /* * In case of a recoverable encoding error, any data before * the error should be written. This data is in the bufObj. @@ -10028,7 +10029,7 @@ static Tcl_Size DoRead( Channel *chanPtr, /* The channel from which to read. */ char *dst, /* Where to store input read. */ - Tcl_Size bytesToRead, /* Maximum number of bytes to read. */ + Tcl_Size bytesToRead, /* Maximum number of bytes to read. */ int allowShortReads) /* Allow half-blocking (pipes,sockets) */ { ChannelState *statePtr = chanPtr->state; @@ -11395,9 +11396,9 @@ Tcl_ChannelTruncateProc( static void DupChannelInternalRep( - Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have + 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 + Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { ResolvedChanName *resPtr; @@ -11452,7 +11453,7 @@ DumpFlags( int i = 0; char buf[24]; -#define ChanFlag(chr, bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_')) +#define ChanFlag(chr, bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_')) ChanFlag('r', TCL_READABLE); ChanFlag('w', TCL_WRITABLE); diff --git a/generic/tclIO.h b/generic/tclIO.h index 00ca422..8823e06 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -39,12 +39,12 @@ typedef struct ChannelBuffer { Tcl_Size refCount; /* Current uses count */ Tcl_Size nextAdded; /* The next position into which a character * will be put in the buffer. */ - Tcl_Size nextRemoved; /* Position of next byte to be removed from + Tcl_Size nextRemoved; /* Position of next byte to be removed from * the buffer. */ Tcl_Size bufLength; /* How big is the buffer? */ struct ChannelBuffer *nextPtr; /* Next buffer in chain. */ - char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real + char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real * buffer occupies this space + bufSize-1 * bytes. This must be the last field in the * structure. */ @@ -96,10 +96,9 @@ typedef struct EventScriptRecord { typedef struct Channel { struct ChannelState *state; /* Split out state information */ - void *instanceData; /* Instance-specific data provided by creator + void *instanceData; /* Instance-specific data provided by creator * of channel. */ - const Tcl_ChannelType *typePtr; - /* Pointer to channel type structure. */ + const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */ struct Channel *downChanPtr;/* Refers to channel this one was stacked * upon. This reference is NULL for normal * channels. See Tcl_StackChannel. */ @@ -216,7 +215,7 @@ typedef struct ChannelState { */ Tcl_Obj* chanMsg; - Tcl_Obj* unreportedMsg; /* Non-NULL if an error report was deferred + Tcl_Obj* unreportedMsg; /* Non-NULL if an error report was deferred * because it happened in the background. The * value is the chanMg, if any. #219's * companion to 'unreportedError'. */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 288a16b..fc4ddb6 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -369,8 +369,8 @@ Tcl_ReadObjCmd( { Tcl_Channel chan; /* The channel to read from. */ int newline, i; /* Discard newline at end? */ - Tcl_WideInt toRead; /* How many bytes to read? */ - Tcl_Size charactersRead; /* How many characters were read? */ + Tcl_WideInt toRead; /* How many bytes to read? */ + Tcl_Size charactersRead; /* How many characters were read? */ int mode; /* Mode in which channel is opened. */ Tcl_Obj *resultPtr, *chanObjPtr; @@ -1199,7 +1199,7 @@ Tcl_OpenObjCmd( static void TcpAcceptCallbacksDeleteProc( - void *clientData, /* Data which was passed when the assocdata + void *clientData, /* Data which was passed when the assocdata * was registered. */ TCL_UNUSED(Tcl_Interp *)) { @@ -1327,7 +1327,7 @@ UnregisterTcpServerInterpCleanupProc( static void AcceptCallbackProc( - void *callbackData, /* The data stored when the callback was + void *callbackData, /* The data stored when the callback was * created in the call to * Tcl_OpenTcpServer. */ Tcl_Channel chan, /* Channel for the newly accepted @@ -1418,7 +1418,7 @@ AcceptCallbackProc( static void TcpServerCloseProc( - void *callbackData) /* The data passed in the call to + void *callbackData) /* The data passed in the call to * Tcl_CreateCloseHandler. */ { AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData; diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 5b521e4..aa63cd0 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -515,7 +515,7 @@ ExecuteCallback( static int TransformBlockModeProc( - void *instanceData, /* State of transformation. */ + void *instanceData, /* State of transformation. */ int mode) /* New blocking mode. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; @@ -850,7 +850,7 @@ TransformOutputProc( static long long TransformWideSeekProc( - void *instanceData, /* The channel to manipulate. */ + void *instanceData, /* The channel to manipulate. */ long long offset, /* Size of movement. */ int mode, /* How to move. */ int *errorCodePtr) /* Location of error flag. */ @@ -1013,7 +1013,7 @@ TransformGetOptionProc( static void TransformWatchProc( - void *instanceData, /* Channel to watch. */ + void *instanceData, /* Channel to watch. */ int mask) /* Events of interest. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; @@ -1091,9 +1091,9 @@ TransformWatchProc( static int TransformGetFileHandleProc( - void *instanceData, /* Channel to query. */ + void *instanceData, /* Channel to query. */ int direction, /* Direction of interest. */ - void **handlePtr) /* Place to store the handle into. */ + void **handlePtr) /* Place to store the handle into. */ { TransformChannelData *dataPtr = (TransformChannelData *)instanceData; @@ -1125,7 +1125,7 @@ TransformGetFileHandleProc( static int TransformNotifyProc( - void *clientData, /* The state of the notified + void *clientData, /* The state of the notified * transformation. */ int mask) /* The mask of occurring events. */ { @@ -1170,7 +1170,7 @@ TransformNotifyProc( static void TransformChannelHandlerTimer( - void *clientData) /* Transformation to query. */ + void *clientData) /* Transformation to query. */ { TransformChannelData *dataPtr = (TransformChannelData *)clientData; diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 4379263..0118ce0 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -62,27 +62,27 @@ static void TimerRunWrite(void *clientData); */ static const Tcl_ChannelType tclRChannelType = { - "tclrchannel", /* Type name. */ - TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Old close API. Deprecated. */ - ReflectInput, /* Handle read request */ - ReflectOutput, /* Handle write request */ + "tclrchannel", /* Type name. */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ + NULL, /* Old close API */ + ReflectInput, /* Handle read request */ + ReflectOutput, /* Handle write request */ NULL, - ReflectSetOption, /* Set options. */ - ReflectGetOption, /* Get options. */ - ReflectWatch, /* Initialize notifier */ - NULL, /* Get OS handle from the channel. */ - ReflectClose, /* Close channel. Clean instance data */ - ReflectBlock, /* Set blocking/nonblocking. */ - NULL, /* Flush channel. */ - NULL, /* Handle events. */ - ReflectSeekWide, /* Move access point (64 bit). */ + ReflectSetOption, /* Set options. */ + ReflectGetOption, /* Get options. */ + ReflectWatch, /* Initialize notifier */ + NULL, /* Get OS handle from the channel. */ + ReflectClose, /* Close channel. Clean instance data */ + ReflectBlock, /* Set blocking/nonblocking. */ + NULL, /* Flush channel. */ + NULL, /* Handle events. */ + ReflectSeekWide, /* Move access point (64 bit). */ #if TCL_THREADS - ReflectThread, /* thread action, tracking owner */ + ReflectThread, /* thread action, tracking owner */ #else - NULL, /* thread action */ + NULL, /* thread action */ #endif - ReflectTruncate /* Truncate. */ + ReflectTruncate /* Truncate. */ }; /* @@ -205,8 +205,9 @@ typedef enum { #define RANDW \ (TCL_READABLE | TCL_WRITABLE) -#define IMPLIES(a, b) ((!(a)) || (b)) -#define HAS(x, f) ((x) & FLAG(f)) +#define IMPLIES(a,b) ((!(a)) || (b)) +#define NEGIMPL(a,b) +#define HAS(x,f) ((x) & FLAG(f)) #if TCL_THREADS /* @@ -396,28 +397,27 @@ static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr, static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(void *clientData); -#define FreeReceivedError(fwdParam) \ - if ((fwdParam)->base.mustFree) { \ - Tcl_Free((fwdParam)->base.msgStr); \ +#define FreeReceivedError(p) \ + if ((p)->base.mustFree) { \ + Tcl_Free((p)->base.msgStr); \ } -#define PassReceivedErrorInterp(interp, fwdParam) \ - if ((interp) != NULL) { \ - Tcl_SetChannelErrorInterp((interp), \ - Tcl_NewStringObj((fwdParam)->base.msgStr, -1)); \ - } \ - FreeReceivedError(fwdParam) -#define PassReceivedError(chan, fwdParam) \ - Tcl_SetChannelError((chan), \ - Tcl_NewStringObj((fwdParam)->base.msgStr, -1)); \ - FreeReceivedError(fwdParam) -#define ForwardSetStaticError(fwdParam, emsg) \ - (fwdParam)->base.code = TCL_ERROR; \ - (fwdParam)->base.mustFree = 0; \ - (fwdParam)->base.msgStr = (char *) (emsg) -#define ForwardSetDynamicError(fwdParam, emsg) \ - (fwdParam)->base.code = TCL_ERROR; \ - (fwdParam)->base.mustFree = 1; \ - (fwdParam)->base.msgStr = (char *) (emsg) +#define PassReceivedErrorInterp(i,p) \ + if ((i) != NULL) { \ + Tcl_SetChannelErrorInterp((i), \ + Tcl_NewStringObj((p)->base.msgStr, -1)); \ + } \ + FreeReceivedError(p) +#define PassReceivedError(c,p) \ + Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \ + FreeReceivedError(p) +#define ForwardSetStaticError(p,emsg) \ + (p)->base.code = TCL_ERROR; \ + (p)->base.mustFree = 0; \ + (p)->base.msgStr = (char *) (emsg) +#define ForwardSetDynamicError(p,emsg) \ + (p)->base.code = TCL_ERROR; \ + (p)->base.mustFree = 1; \ + (p)->base.msgStr = (char *) (emsg) static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); @@ -426,8 +426,8 @@ static Tcl_ExitProc DeleteThreadReflectedChannelMap; #endif /* TCL_THREADS */ -#define SetChannelErrorStr(chan, msgStr) \ - Tcl_SetChannelError((chan), Tcl_NewStringObj((msgStr), -1)) +#define SetChannelErrorStr(c,msgStr) \ + Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1)) static Tcl_Obj * MarshallError(Tcl_Interp *interp); static void UnmarshallErrorResult(Tcl_Interp *interp, @@ -1760,7 +1760,7 @@ ReflectBlock( Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); errorNum = EINVAL; } else { @@ -1830,7 +1830,7 @@ ReflectThread( static int ReflectSetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ const char *newValue) /* The new value */ @@ -1872,7 +1872,7 @@ ReflectSetOption( Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); - result = InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, &resObj); + result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj); if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); } @@ -1902,7 +1902,7 @@ ReflectSetOption( static int ReflectGetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of reuqested option */ Tcl_DString *dsPtr) /* String to place the result into */ @@ -2055,7 +2055,7 @@ ReflectGetOption( static int ReflectTruncate( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ long long length) /* Length to truncate to. */ { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; @@ -2091,7 +2091,7 @@ ReflectTruncate( lenObj = Tcl_NewWideIntObj(length); Tcl_IncrRefCount(lenObj); - if (InvokeTclMethod(rcPtr, METH_TRUNCATE, lenObj, NULL, &resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); errorNum = EINVAL; } else { @@ -2138,7 +2138,7 @@ EncodeEventMask( int *mask) { int events; /* Mask of events to post */ - Tcl_Size listc; /* #elements in eventspec list */ + Tcl_Size listc; /* #elements in eventspec list */ Tcl_Obj **listv; /* Elements of eventspec list */ int evIndex; /* Id of event for an element of the eventspec * list. */ @@ -2376,7 +2376,7 @@ InvokeTclMethod( */ if (resultObjPtr != NULL) { - resObj = Tcl_NewStringObj(msg_dstlost, -1); + resObj = Tcl_NewStringObj(msg_dstlost,-1); *resultObjPtr = resObj; Tcl_IncrRefCount(resObj); } @@ -2614,13 +2614,13 @@ MarkDead( static void DeleteReflectedChannelMap( - void *clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData; /* The map */ - Tcl_HashSearch hSearch; /* Search variable. */ - Tcl_HashEntry *hPtr; /* Search variable. */ + Tcl_HashSearch hSearch; /* Search variable. */ + Tcl_HashEntry *hPtr; /* Search variable. */ ReflectedChannel *rcPtr; Tcl_Channel chan; #if TCL_THREADS @@ -3340,7 +3340,7 @@ ForwardProc( Tcl_IncrRefCount(lenObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, METH_TRUNCATE, lenObj, NULL, &resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 869c19d..2ad6ecf0 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -209,9 +209,9 @@ typedef enum { #define RANDW \ (TCL_READABLE | TCL_WRITABLE) -#define IMPLIES(a, b) ((!(a)) || (b)) -#define NEGIMPL(a, b) -#define HAS(x, f) ((x) & FLAG(f)) +#define IMPLIES(a,b) ((!(a)) || (b)) +#define NEGIMPL(a,b) +#define HAS(x,f) ((x) & FLAG(f)) #if TCL_THREADS /* @@ -356,37 +356,37 @@ static void ForwardOpToOwnerThread(ReflectedTransform *rtPtr, static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(void *clientData); -#define FreeReceivedError(fwdParam) \ +#define FreeReceivedError(p) \ do { \ - if ((fwdParam)->base.mustFree) { \ - Tcl_Free((fwdParam)->base.msgStr); \ + if ((p)->base.mustFree) { \ + Tcl_Free((p)->base.msgStr); \ } \ } while (0) -#define PassReceivedErrorInterp(interp, fwdParam) \ +#define PassReceivedErrorInterp(i,p) \ do { \ - if ((interp) != NULL) { \ - Tcl_SetChannelErrorInterp((interp), \ - Tcl_NewStringObj((fwdParam)->base.msgStr, -1)); \ + if ((i) != NULL) { \ + Tcl_SetChannelErrorInterp((i), \ + Tcl_NewStringObj((p)->base.msgStr, -1)); \ } \ - FreeReceivedError(fwdParam); \ + FreeReceivedError(p); \ } while (0) -#define PassReceivedError(chan, fwdParam) \ +#define PassReceivedError(c,p) \ do { \ - Tcl_SetChannelError((chan), \ - Tcl_NewStringObj((fwdParam)->base.msgStr, -1)); \ - FreeReceivedError(fwdParam); \ + Tcl_SetChannelError((c), \ + Tcl_NewStringObj((p)->base.msgStr, -1)); \ + FreeReceivedError(p); \ } while (0) -#define ForwardSetStaticError(fwdParam, emsg) \ +#define ForwardSetStaticError(p,emsg) \ do { \ - (fwdParam)->base.code = TCL_ERROR; \ - (fwdParam)->base.mustFree = 0; \ - (fwdParam)->base.msgStr = (char *) (emsg); \ + (p)->base.code = TCL_ERROR; \ + (p)->base.mustFree = 0; \ + (p)->base.msgStr = (char *) (emsg); \ } while (0) -#define ForwardSetDynamicError(fwdParam, emsg) \ +#define ForwardSetDynamicError(p,emsg) \ do { \ - (fwdParam)->base.code = TCL_ERROR; \ - (fwdParam)->base.mustFree = 1; \ - (fwdParam)->base.msgStr = (char *) (emsg); \ + (p)->base.code = TCL_ERROR; \ + (p)->base.mustFree = 1; \ + (p)->base.msgStr = (char *) (emsg); \ } while (0) static void ForwardSetObjError(ForwardParam *p, @@ -396,8 +396,8 @@ static void DeleteThreadReflectedTransformMap( void *clientData); #endif /* TCL_THREADS */ -#define SetChannelErrorStr(chan, msgStr) \ - Tcl_SetChannelError((chan), Tcl_NewStringObj((msgStr), -1)) +#define SetChannelErrorStr(c,msgStr) \ + Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1)) static Tcl_Obj * MarshallError(Tcl_Interp *interp); static void UnmarshallErrorResult(Tcl_Interp *interp, @@ -599,9 +599,9 @@ TclChanPushObjCmd( */ if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s initialize\" returned non-list: %s", - TclGetString(cmdObj), TclGetString(resObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s initialize\" returned non-list: %s", + TclGetString(cmdObj), TclGetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } @@ -624,9 +624,9 @@ TclChanPushObjCmd( Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" does not support all required methods", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" does not support all required methods", + TclGetString(cmdObj))); goto error; } @@ -646,9 +646,9 @@ TclChanPushObjCmd( } if (!mode) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" makes the channel inaccessible", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" makes the channel inaccessible", + TclGetString(cmdObj))); goto error; } @@ -657,16 +657,16 @@ TclChanPushObjCmd( */ if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"drain\" but not \"read\"", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"drain\" but not \"read\"", + TclGetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"flush\" but not \"write\"", - TclGetString(cmdObj))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"flush\" but not \"write\"", + TclGetString(cmdObj))); goto error; } @@ -1926,7 +1926,7 @@ InvokeTclMethod( */ if (resultObjPtr != NULL) { - resObj = Tcl_NewStringObj(msg_dstlost, -1); + resObj = Tcl_NewStringObj(msg_dstlost,-1); *resultObjPtr = resObj; Tcl_IncrRefCount(resObj); } diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 2ace4ce..81526fa 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -191,7 +191,7 @@ TclCreateSocketAddress( if (host != NULL) { if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, NULL) != TCL_OK) { - Tcl_DStringFree(&ds); + Tcl_DStringFree(&ds); return 0; } native = Tcl_DStringValue(&ds); @@ -263,7 +263,7 @@ TclCreateSocketAddress( (result == EAI_SYSTEM) ? Tcl_PosixError(interp) : #endif /* EAI_SYSTEM */ gai_strerror(result); - return 0; + return 0; } /* diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 284b9d4..c3131cd 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -245,7 +245,7 @@ Tcl_Stat( { int ret; Tcl_StatBuf buf; - Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); + Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSStat(pathPtr, &buf); @@ -332,10 +332,10 @@ Tcl_Access( int mode) /* Permission setting. */ { int ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); + Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); Tcl_IncrRefCount(pathPtr); - ret = Tcl_FSAccess(pathPtr, mode); + ret = Tcl_FSAccess(pathPtr,mode); Tcl_DecrRefCount(pathPtr); return ret; @@ -352,7 +352,7 @@ Tcl_OpenFileChannel( int permissions) /* The modes to use if creating a new file. */ { Tcl_Channel ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); + Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions); @@ -367,7 +367,7 @@ Tcl_Chdir( const char *dirName) { int ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName, -1); + Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSChdir(pathPtr); Tcl_DecrRefCount(pathPtr); @@ -399,7 +399,7 @@ Tcl_EvalFile( * pathaname. */ { int ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName, -1); + Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1); Tcl_IncrRefCount(pathPtr); ret = Tcl_FSEvalFile(interp, pathPtr); @@ -1568,8 +1568,8 @@ TclGetOpenMode( if (mode & O_APPEND) { accessFlagRepeated: if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "access mode \"%s\" repeated", flag)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "access mode \"%s\" repeated", flag)); } goto invAccessMode; } @@ -1577,7 +1577,7 @@ TclGetOpenMode( *modeFlagsPtr |= 1; } else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) { if (mode & O_CREAT) { - goto accessFlagRepeated; + goto accessFlagRepeated; } mode |= O_CREAT; } else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) { @@ -1735,7 +1735,7 @@ Tcl_FSEvalFileEx( } if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { - Tcl_CloseEx(interp, chan, 0); + Tcl_CloseEx(interp,chan,0); return result; } @@ -2006,7 +2006,7 @@ Tcl_GetErrno(void) * Tcl_SetErrno -- * * Sets the Tcl error code to the given value. On some saner platforms - * this is implemented in the C library as a thread-local value, but this + * this is implemented in the C library as a thread-local value , but this * is *really* unsafe to assume! * * Results: @@ -2358,7 +2358,7 @@ NativeFileAttrsGet( Tcl_Obj *pathPtr, /* Pathname of the file */ Tcl_Obj **objPtrRef) /* Where to store the a pointer to the result. */ { - return tclpFileAttrProcs[index].getProc(interp, index, pathPtr, objPtrRef); + return tclpFileAttrProcs[index].getProc(interp, index, pathPtr,objPtrRef); } /* @@ -2653,7 +2653,7 @@ Tcl_FSGetCwd( retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd); Tcl_IncrRefCount(retVal); - norm = TclFSNormalizeAbsolutePath(interp, retVal); + norm = TclFSNormalizeAbsolutePath(interp,retVal); if (norm != NULL) { /* * Assign to global storage the pathname of the current @@ -2785,7 +2785,7 @@ Tcl_FSGetCwd( norm = TclFSNormalizeAbsolutePath(interp, retVal); if (norm == NULL) { - /* + /* * 'norm' shouldn't ever be NULL, but we are careful. */ @@ -2796,7 +2796,7 @@ Tcl_FSGetCwd( } else if (norm == tsdPtr->cwdPathPtr) { goto cdEqual; } else { - /* + /* * Determine whether the filesystem's answer is the same as the * cached local value. Since both 'norm' and 'tsdPtr->cwdPathPtr' * are normalized pathnames, do something more efficient than @@ -4014,7 +4014,7 @@ TclFSNonnativePathType( numVolumes--; Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol); - strVol = TclGetStringFromObj(vol, &len); + strVol = TclGetStringFromObj(vol,&len); if (pathLen < len) { continue; } @@ -4636,7 +4636,7 @@ NativeFilesystemSeparator( separator = "\\"; break; } - return Tcl_NewStringObj(separator, 1); + return Tcl_NewStringObj(separator,1); } /* diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 5f6827d..3e92b5a 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -55,7 +55,7 @@ const Tcl_ObjType tclIndexType = { typedef struct { void *tablePtr; /* Pointer to the table of strings */ - Tcl_Size offset; /* Offset between table entries */ + Tcl_Size offset; /* Offset between table entries */ Tcl_Size index; /* Selected index into table. */ } IndexRep; @@ -282,21 +282,20 @@ Tcl_GetIndexFromObjStruct( * operation. */ - if (objPtr && (index != TCL_INDEX_NONE) - && !(flags & TCL_INDEX_TEMP_TABLE)) { - irPtr = TclFetchInternalRep(objPtr, &tclIndexType); - if (irPtr) { - indexRep = (IndexRep *) irPtr->twoPtrValue.ptr1; - } else { - Tcl_ObjInternalRep ir; + if (objPtr && (index != TCL_INDEX_NONE) && !(flags & TCL_INDEX_TEMP_TABLE)) { + irPtr = TclFetchInternalRep(objPtr, &tclIndexType); + if (irPtr) { + indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; + } else { + Tcl_ObjInternalRep ir; - indexRep = (IndexRep *) Tcl_Alloc(sizeof(IndexRep)); - ir.twoPtrValue.ptr1 = indexRep; - Tcl_StoreInternalRep(objPtr, &tclIndexType, &ir); - } - indexRep->tablePtr = (void *) tablePtr; - indexRep->offset = offset; - indexRep->index = index; + indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep)); + ir.twoPtrValue.ptr1 = indexRep; + Tcl_StoreInternalRep(objPtr, &tclIndexType, &ir); + } + indexRep->tablePtr = (void *) tablePtr; + indexRep->offset = offset; + indexRep->index = index; } uncachedDone: @@ -807,7 +806,7 @@ PrefixLongestObjCmd( void Tcl_WrongNumArgs( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments to print from objv. */ + Tcl_Size objc, /* Number of arguments to print from objv. */ Tcl_Obj *const objv[], /* Initial argument objects, which should be * included in the error message. */ const char *message) /* Error message to print after the leading @@ -1003,19 +1002,20 @@ Tcl_ParseArgsObjv( * successful exit. Will include the name of * the command. */ Tcl_Size nrem; /* Size of leftovers.*/ - const Tcl_ArgvInfo *infoPtr;/* Pointer to the current entry in the table + 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 + char c; /* Second character of current arg (used for * quick check for matching; use 2nd char. * because first char. will almost always be * '-'). */ - Tcl_Size srcIndex; /* Location from which to read next argument + Tcl_Size srcIndex; /* Location from which to read next argument * from objv. */ - Tcl_Size dstIndex; /* Used to keep track of current arguments + Tcl_Size dstIndex; /* Used to keep track of current arguments * being processed, primarily for error * reporting. */ Tcl_Size objc; /* # arguments in objv still to process. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index bb0178b..768143c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -790,7 +790,7 @@ typedef struct VarInHash { (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT #define TclSetVarUndefined(varPtr) \ - (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT); \ + (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT);\ (varPtr)->value.objPtr = NULL #define TclClearVarUndefined(varPtr) @@ -802,19 +802,19 @@ typedef struct VarInHash { (varPtr)->flags &= ~VAR_TRACE_ACTIVE #define TclSetVarNamespaceVar(varPtr) \ - if (!TclIsVarNamespaceVar(varPtr)) { \ - (varPtr)->flags |= VAR_NAMESPACE_VAR; \ - if (TclIsVarInHash(varPtr)) { \ - ((VarInHash *)(varPtr))->refCount++; \ - } \ + if (!TclIsVarNamespaceVar(varPtr)) {\ + (varPtr)->flags |= VAR_NAMESPACE_VAR;\ + if (TclIsVarInHash(varPtr)) {\ + ((VarInHash *)(varPtr))->refCount++;\ + }\ } #define TclClearVarNamespaceVar(varPtr) \ - if (TclIsVarNamespaceVar(varPtr)) { \ - (varPtr)->flags &= ~VAR_NAMESPACE_VAR; \ - if (TclIsVarInHash(varPtr)) { \ - ((VarInHash *)(varPtr))->refCount--; \ - } \ + if (TclIsVarNamespaceVar(varPtr)) {\ + (varPtr)->flags &= ~VAR_NAMESPACE_VAR;\ + if (TclIsVarInHash(varPtr)) {\ + ((VarInHash *)(varPtr))->refCount--;\ + }\ } /* @@ -832,7 +832,7 @@ typedef struct VarInHash { * MODULE_SCOPE int TclIsVarResolved(Var *varPtr); */ -#define TclVarFindHiddenArray(varPtr, arrayPtr) \ +#define TclVarFindHiddenArray(varPtr,arrayPtr) \ do { \ if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ (TclVarParentArray(varPtr) != NULL)) { \ @@ -884,7 +884,7 @@ typedef struct VarInHash { ((varPtr)->flags & VAR_DEAD_HASH) #define TclGetVarNsPtr(varPtr) \ - (TclIsVarInHash(varPtr) \ + (TclIsVarInHash(varPtr) \ ? ((TclVarHashTable *) ((((VarInHash *) (varPtr))->entry.tablePtr)))->nsPtr \ : NULL) @@ -901,38 +901,36 @@ typedef struct VarInHash { * Macros for direct variable access by TEBC. */ -#define TclIsVarTricky(varPtr, trickyFlags) \ +#define TclIsVarTricky(varPtr,trickyFlags) \ ( ((varPtr)->flags & (VAR_ARRAY|VAR_LINK|trickyFlags)) \ || (TclIsVarInHash(varPtr) \ && (TclVarParentArray(varPtr) != NULL) \ && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) -#define TclIsVarDirectReadable(varPtr) \ - ( (!TclIsVarTricky(varPtr, VAR_TRACED_READ)) \ +#define TclIsVarDirectReadable(varPtr) \ + ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ)) \ && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ - (!TclIsVarTricky(varPtr, VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT)) + (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT)) #define TclIsVarDirectUnsettable(varPtr) \ - (!TclIsVarTricky(varPtr, \ - VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH|VAR_CONSTANT)) + (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH|VAR_CONSTANT)) #define TclIsVarDirectModifyable(varPtr) \ - ( (!TclIsVarTricky(varPtr, \ - VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT)) \ + ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT)) \ && (varPtr)->value.objPtr) #define TclIsVarDirectReadable2(varPtr, arrayPtr) \ - (TclIsVarDirectReadable(varPtr) && \ + (TclIsVarDirectReadable(varPtr) &&\ (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ))) #define TclIsVarDirectWritable2(varPtr, arrayPtr) \ - (TclIsVarDirectWritable(varPtr) && \ + (TclIsVarDirectWritable(varPtr) &&\ (!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_WRITE))) #define TclIsVarDirectModifyable2(varPtr, arrayPtr) \ - (TclIsVarDirectModifyable(varPtr) && \ + (TclIsVarDirectModifyable(varPtr) &&\ (!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE)))) /* @@ -1104,8 +1102,7 @@ typedef struct ActiveInterpTrace { #define TCL_TRACE_LEAVE_EXEC 2 #if TCL_MAJOR_VERSION > 8 -#define TclObjTypeHasProc(objPtr, proc) \ - (((objPtr)->typePtr \ +#define TclObjTypeHasProc(objPtr, proc) (((objPtr)->typePtr \ && ((offsetof(Tcl_ObjType, proc) < offsetof(Tcl_ObjType, version)) \ || (offsetof(Tcl_ObjType, proc) < (objPtr)->typePtr->version))) ? \ ((objPtr)->typePtr)->proc : NULL) @@ -2624,68 +2621,68 @@ typedef struct ListRep { */ /* Returns the starting slot for this listRep in the contained ListStore */ -#define ListRepStart(listRepPtr) \ - ((listRepPtr)->spanPtr \ - ? (listRepPtr)->spanPtr->spanStart \ - : (listRepPtr)->storePtr->firstUsed) +#define ListRepStart(listRepPtr_) \ + ((listRepPtr_)->spanPtr \ + ? (listRepPtr_)->spanPtr->spanStart \ + : (listRepPtr_)->storePtr->firstUsed) /* Returns the number of elements in this listRep */ -#define ListRepLength(listRepPtr) \ - ((listRepPtr)->spanPtr \ - ? (listRepPtr)->spanPtr->spanLength \ - : (listRepPtr)->storePtr->numUsed) +#define ListRepLength(listRepPtr_) \ + ((listRepPtr_)->spanPtr \ + ? (listRepPtr_)->spanPtr->spanLength \ + : (listRepPtr_)->storePtr->numUsed) /* Returns a pointer to the first slot containing this ListRep elements */ -#define ListRepElementsBase(listRepPtr) \ - (&(listRepPtr)->storePtr->slots[ListRepStart(listRepPtr)]) +#define ListRepElementsBase(listRepPtr_) \ + (&(listRepPtr_)->storePtr->slots[ListRepStart(listRepPtr_)]) /* Stores the number of elements and base address of the element array */ -#define ListRepElements(listRepPtr, objc, objv) \ - (((objv) = ListRepElementsBase(listRepPtr)), \ - ((objc) = ListRepLength(listRepPtr))) +#define ListRepElements(listRepPtr_, objc_, objv_) \ + (((objv_) = ListRepElementsBase(listRepPtr_)), \ + ((objc_) = ListRepLength(listRepPtr_))) /* Returns 1/0 whether the ListRep's ListStore is shared. */ -#define ListRepIsShared(listRepPtr) ((listRepPtr)->storePtr->refCount > 1) +#define ListRepIsShared(listRepPtr_) ((listRepPtr_)->storePtr->refCount > 1) /* Returns a pointer to the ListStore component */ -#define ListObjStorePtr(listObj) \ - ((ListStore *)((listObj)->internalRep.twoPtrValue.ptr1)) +#define ListObjStorePtr(listObj_) \ + ((ListStore *)((listObj_)->internalRep.twoPtrValue.ptr1)) /* Returns a pointer to the ListSpan component */ -#define ListObjSpanPtr(listObj) \ - ((ListSpan *)((listObj)->internalRep.twoPtrValue.ptr2)) +#define ListObjSpanPtr(listObj_) \ + ((ListSpan *)((listObj_)->internalRep.twoPtrValue.ptr2)) /* Returns the ListRep internal representaton in a Tcl_Obj */ -#define ListObjGetRep(listObj, listRepPtr) \ +#define ListObjGetRep(listObj_, listRepPtr_) \ do { \ - (listRepPtr)->storePtr = ListObjStorePtr(listObj); \ - (listRepPtr)->spanPtr = ListObjSpanPtr(listObj); \ + (listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \ + (listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_); \ } while (0) -/* Retrieves the length of the list */ -#define ListObjLength(listObj, len) \ - ((len) = ListObjSpanPtr(listObj) \ - ? ListObjSpanPtr(listObj)->spanLength \ - : ListObjStorePtr(listObj)->numUsed) +/* Returns the length of the list */ +#define ListObjLength(listObj_, len_) \ + ((len_) = ListObjSpanPtr(listObj_) \ + ? ListObjSpanPtr(listObj_)->spanLength \ + : ListObjStorePtr(listObj_)->numUsed) /* Returns the starting slot index of this list's elements in the ListStore */ -#define ListObjStart(listObj) \ - (ListObjSpanPtr(listObj) \ - ? ListObjSpanPtr(listObj)->spanStart \ - : ListObjStorePtr(listObj)->firstUsed) +#define ListObjStart(listObj_) \ + (ListObjSpanPtr(listObj_) \ + ? ListObjSpanPtr(listObj_)->spanStart \ + : ListObjStorePtr(listObj_)->firstUsed) /* Stores the element count and base address of this list's elements */ -#define ListObjGetElements(listObj, objc, objv) \ - (((objv) = &ListObjStorePtr(listObj)->slots[ListObjStart(listObj)]), \ - (ListObjLength(listObj, (objc)))) +#define ListObjGetElements(listObj_, objc_, objv_) \ + (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \ + (ListObjLength(listObj_, (objc_)))) /* * Returns 1/0 whether the internal representation (not the Tcl_Obj itself) * is shared. Note by intent this only checks for sharing of ListStore, * not spans. */ -#define ListObjRepIsShared(listObj) \ - (ListObjStorePtr(listObj)->refCount > 1) +#define ListObjRepIsShared(listObj_) \ + (ListObjStorePtr(listObj_)->refCount > 1) /* * Certain commands like concat are optimized if an existing string @@ -2702,37 +2699,37 @@ typedef struct ListRep { * and never from strings (see SetListFromAny) and thus their string * representation will always be canonical. */ -#define ListObjIsCanonical(listObj) \ - (((listObj)->bytes == NULL) \ - || (ListObjStorePtr(listObj)->flags & LISTSTORE_CANONICAL) \ - || ListObjSpanPtr(listObj) != NULL) +#define ListObjIsCanonical(listObj_) \ + (((listObj_)->bytes == NULL) \ + || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \ + || ListObjSpanPtr(listObj_) != NULL) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element - * count and base address of this list's elements in objcPtr and objvPtr. + * count and base address of this list's elements in objcPtr_ and objvPtr_. * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be * converted to a list. */ -#define TclListObjGetElements(interp, listObj, objcPtr, objvPtr) \ - ((TclHasInternalRep((listObj), &tclListType)) \ - ? ((ListObjGetElements((listObj), *(objcPtr), *(objvPtr))), \ +#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ TCL_OK) \ : Tcl_ListObjGetElements( \ - (interp), (listObj), (objcPtr), (objvPtr))) + (interp_), (listObj_), (objcPtr_), (objvPtr_))) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element - * count in lenPtr. Returns TCL_OK on success or TCL_ERROR if the + * count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the * Tcl_Obj cannot be converted to a list. */ -#define TclListObjLength(interp, listObj, lenPtr) \ - ((TclHasInternalRep((listObj), &tclListType)) \ - ? ((ListObjLength((listObj), *(lenPtr))), TCL_OK) \ - : Tcl_ListObjLength((interp), (listObj), (lenPtr))) +#define TclListObjLength(interp_, listObj_, lenPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ + : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) -#define TclListObjIsCanonical(listObj) \ - ((TclHasInternalRep((listObj), &tclListType)) \ - ? ListObjIsCanonical((listObj)) \ +#define TclListObjIsCanonical(listObj_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ListObjIsCanonical((listObj_)) \ : 0) /* @@ -2969,12 +2966,12 @@ typedef struct ProcessGlobalValue { */ #define ENCODING_PROFILE_MASK 0xFF000000 -#define ENCODING_PROFILE_GET(flags) \ - ((flags) & ENCODING_PROFILE_MASK) -#define ENCODING_PROFILE_SET(flags, profile) \ +#define ENCODING_PROFILE_GET(flags_) \ + ((flags_) & ENCODING_PROFILE_MASK) +#define ENCODING_PROFILE_SET(flags_, profile_) \ do { \ - (flags) &= ~ENCODING_PROFILE_MASK; \ - (flags) |= ((profile) & ENCODING_PROFILE_MASK); \ + (flags_) &= ~ENCODING_PROFILE_MASK; \ + (flags_) |= ((profile_) & ENCODING_PROFILE_MASK); \ } while (0) /* @@ -3218,8 +3215,8 @@ typedef struct ForIterData { } ForIterData; /* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile - * and Tcl_FindSymbol. This structure corresponds to an opaque - * typedef in tcl.h */ + * and Tcl_FindSymbol. This structure corresponds to an opaque + * typedef in tcl.h */ typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, const char* symbol); @@ -4279,22 +4276,21 @@ MODULE_SCOPE void TclpFreeAllocCache(void *); # define ALLOC_NOBJHIGH 1200 -# define TclAllocObjStorageEx(interp, objPtr) \ +# define TclAllocObjStorageEx(interp, objPtr) \ do { \ AllocCache *cachePtr; \ if (((interp) == NULL) || \ - ((cachePtr = ((Interp *) (interp))->allocCache), \ + ((cachePtr = ((Interp *)(interp))->allocCache), \ (cachePtr->numObjects == 0))) { \ (objPtr) = TclThreadAllocObj(); \ } else { \ (objPtr) = cachePtr->firstObjPtr; \ - cachePtr->firstObjPtr = (Tcl_Obj *) \ - (objPtr)->internalRep.twoPtrValue.ptr1; \ + cachePtr->firstObjPtr = (Tcl_Obj *)(objPtr)->internalRep.twoPtrValue.ptr1; \ --cachePtr->numObjects; \ } \ } while (0) -# define TclFreeObjStorageEx(interp, objPtr) \ +# define TclFreeObjStorageEx(interp, objPtr) \ do { \ AllocCache *cachePtr; \ if (((interp) == NULL) || \ @@ -4349,7 +4345,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, int line); # define TclDbNewObj(objPtr, file, line) \ - do { \ + do { \ TclIncrObjsAllocated(); \ (objPtr) = (Tcl_Obj *) \ Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \ @@ -4462,7 +4458,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, #define TclInvalidateStringRep(objPtr) \ do { \ - Tcl_Obj *_isobjPtr = (Tcl_Obj *) (objPtr); \ + Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ if (_isobjPtr->bytes != NULL) { \ if (_isobjPtr->bytes != &tclEmptyString) { \ Tcl_Free((char *)_isobjPtr->bytes); \ @@ -4962,7 +4958,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; #define TclSmallFreeEx(interp, memPtr) \ do { \ - TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr)); \ + TclFreeObjStorageEx((interp), (Tcl_Obj *)(memPtr)); \ TclIncrObjsFreed(); \ } while (0) @@ -4977,7 +4973,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; #define TclSmallFreeEx(interp, memPtr) \ do { \ - Tcl_Obj *_objPtr = (Tcl_Obj *) (memPtr); \ + Tcl_Obj *_objPtr = (Tcl_Obj *)(memPtr); \ _objPtr->bytes = NULL; \ _objPtr->typePtr = NULL; \ _objPtr->refCount = 1; \ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index d3a27b7..5fbefbf 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -196,12 +196,12 @@ struct LimitHandler { /* * Values for the LimitHandler flags field. - * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being - * processed; handlers are never to be reentered. - * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This - * should not normally be observed because when a handler is - * deleted it is also spliced out of the list of handlers, but - * even so we will be careful. + * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being + * processed; handlers are never to be reentered. + * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This + * should not normally be observed because when a handler is + * deleted it is also spliced out of the list of handlers, but + * even so we will be careful. */ #define LIMIT_HANDLER_ACTIVE 0x01 @@ -600,9 +600,9 @@ InterpInfoDeleteProc( int Tcl_InterpObjCmd( void *clientData, - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv); } @@ -610,9 +610,9 @@ Tcl_InterpObjCmd( static int NRInterpCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *childInterp; static const char *const options[] = { @@ -1007,7 +1007,7 @@ NRInterpCmd( } switch (limitType) { case LIMIT_TYPE_COMMANDS: - return ChildCommandLimitCmd(interp, childInterp, 4, objc, objv); + return ChildCommandLimitCmd(interp, childInterp, 4, objc,objv); case LIMIT_TYPE_TIME: return ChildTimeLimitCmd(interp, childInterp, 4, objc, objv); } @@ -1162,7 +1162,7 @@ static Tcl_Interp * GetInterp2( Tcl_Interp *interp, /* Default interp if no interp was specified * on the command line. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc == 2) { @@ -1197,7 +1197,7 @@ Tcl_CreateAlias( const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - Tcl_Size argc, /* How many additional arguments? */ + Tcl_Size argc, /* How many additional arguments? */ const char *const *argv) /* These are the additional args. */ { Tcl_Obj *childObjPtr, *targetObjPtr; @@ -1252,7 +1252,7 @@ Tcl_CreateAliasObj( const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - Tcl_Size objc, /* How many additional arguments? */ + Tcl_Size objc, /* How many additional arguments? */ Tcl_Obj *const objv[]) /* Argument vector. */ { Tcl_Obj *childObjPtr, *targetObjPtr; @@ -1459,7 +1459,7 @@ AliasCreate( * invoked. */ Tcl_Obj *namePtr, /* Name of alias cmd. */ Tcl_Obj *targetCmdPtr, /* Name of target cmd. */ - Tcl_Size objc, /* Additional arguments to store */ + Tcl_Size objc, /* Additional arguments to store */ Tcl_Obj *const objv[]) /* with alias. */ { Alias *aliasPtr; @@ -1759,7 +1759,7 @@ AliasList( static int AliasNRCmd( - void *clientData, /* Alias record. */ + void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ @@ -1812,7 +1812,7 @@ AliasNRCmd( int TclAliasObjCmd( - void *clientData, /* Alias record. */ + void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ @@ -1904,7 +1904,7 @@ TclAliasObjCmd( int TclLocalAliasObjCmd( - void *clientData, /* Alias record. */ + void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ @@ -1990,7 +1990,7 @@ TclLocalAliasObjCmd( static void AliasObjCmdDeleteProc( - void *clientData) /* The alias record for this alias. */ + void *clientData) /* The alias record for this alias. */ { Alias *aliasPtr = (Alias *)clientData; Target *targetPtr; @@ -2216,7 +2216,7 @@ TclSetChildCancelFlags( int Tcl_GetInterpPath( - Tcl_Interp *interp, /* Interpreter to start search from. */ + Tcl_Interp *interp, /* Interpreter to start search from. */ Tcl_Interp *targetInterp) /* Interpreter to find. */ { InterpInfo *iiPtr; @@ -2318,7 +2318,7 @@ static int ChildBgerror( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ - Tcl_Size objc, /* Set or Query. */ + Tcl_Size objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc) { @@ -2491,7 +2491,7 @@ ChildCreate( int TclChildObjCmd( - void *clientData, /* Child interpreter. */ + void *clientData, /* Child interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2501,7 +2501,7 @@ TclChildObjCmd( static int NRChildCmd( - void *clientData, /* Child interpreter. */ + void *clientData, /* Child interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -2661,7 +2661,7 @@ NRChildCmd( } switch (limitType) { case LIMIT_TYPE_COMMANDS: - return ChildCommandLimitCmd(interp, childInterp, 3, objc, objv); + return ChildCommandLimitCmd(interp, childInterp, 3, objc,objv); case LIMIT_TYPE_TIME: return ChildTimeLimitCmd(interp, childInterp, 3, objc, objv); } @@ -2705,7 +2705,7 @@ NRChildCmd( static void ChildObjCmdDeleteProc( - void *clientData) /* The ChildRecord for the command. */ + void *clientData) /* The ChildRecord for the command. */ { Child *childPtr; /* Interim storage for Child record. */ Tcl_Interp *childInterp = (Tcl_Interp *)clientData; @@ -2753,7 +2753,7 @@ ChildDebugCmd( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const debugTypes[] = { @@ -2824,7 +2824,7 @@ ChildEval( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; @@ -2887,7 +2887,7 @@ static int ChildExpose( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; @@ -2931,7 +2931,7 @@ static int ChildRecursionLimit( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ - Tcl_Size objc, /* Set or Query. */ + Tcl_Size objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { Interp *iPtr; @@ -2993,7 +2993,7 @@ static int ChildHide( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; @@ -3037,10 +3037,10 @@ ChildHidden( Tcl_Interp *interp, /* Interp for data return. */ Tcl_Interp *childInterp) /* Interp whose hidden commands to query. */ { - Tcl_Obj *listObjPtr; /* Local object pointer. */ - Tcl_HashTable *hTblPtr; /* For local searches. */ - Tcl_HashEntry *hPtr; /* For local searches. */ - Tcl_HashSearch hSearch; /* For local searches. */ + Tcl_Obj *listObjPtr; /* Local object pointer. */ + Tcl_HashTable *hTblPtr; /* For local searches. */ + Tcl_HashEntry *hPtr; /* For local searches. */ + Tcl_HashSearch hSearch; /* For local searches. */ TclNewObj(listObjPtr); hTblPtr = ((Interp *) childInterp)->hiddenCmdTablePtr; @@ -3078,7 +3078,7 @@ ChildInvokeHidden( Tcl_Interp *childInterp, /* The child interpreter in which command will * be invoked. */ const char *namespaceName, /* The namespace to use, if any. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; @@ -4421,8 +4421,8 @@ static int ChildCommandLimitCmd( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Interp *childInterp, /* Interpreter being adjusted. */ - Tcl_Size consumedObjc, /* Number of args already parsed. */ - Tcl_Size objc, /* Total number of arguments. */ + Tcl_Size consumedObjc, /* Number of args already parsed. */ + Tcl_Size objc, /* Total number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { @@ -4606,11 +4606,11 @@ ChildCommandLimitCmd( static int ChildTimeLimitCmd( - Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Interp *childInterp, /* Interpreter being adjusted. */ - Tcl_Size consumedObjc, /* Number of args already parsed. */ - Tcl_Size objc, /* Total number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *childInterp, /* Interpreter being adjusted. */ + Tcl_Size consumedObjc, /* Number of args already parsed. */ + Tcl_Size objc, /* Total number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { "-command", "-granularity", "-milliseconds", "-seconds", NULL diff --git a/generic/tclLink.c b/generic/tclLink.c index 2fe9d16..3bd855b 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -36,7 +36,7 @@ typedef struct { Tcl_Size bytes; /* Size of C variable array. This is 0 when * single variables, and >0 used for array * variables. */ - Tcl_Size numElems; /* Number of elements in C variable array. + Tcl_Size numElems; /* Number of elements in C variable array. * Zero for single variables. */ int type; /* Type of link (TCL_LINK_INT, etc.). */ union { @@ -110,11 +110,11 @@ static int SetInvalidRealFromAny(Tcl_Interp *interp, */ static Tcl_ObjType invalidRealType = { - "invalidReal", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - NULL, /* updateStringProc */ - NULL, /* setFromAnyProc */ + "invalidReal", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; @@ -300,7 +300,7 @@ Tcl_LinkArray( /* * If no address is given create one and use as address the - * not needed linkPtr->lastValue + * not needed linkPtr->lastValue */ if (addr == NULL) { @@ -680,7 +680,7 @@ GetInvalidDoubleFromObj( static char * LinkTraceProc( - void *clientData, /* Contains information about the link. */ + void *clientData, /* Contains information about the link. */ Tcl_Interp *interp, /* Interpreter containing Tcl variable. */ TCL_UNUSED(const char *) /*name1*/, TCL_UNUSED(const char *) /*name2*/, @@ -809,7 +809,7 @@ LinkTraceProc( TCL_GLOBAL_ONLY); return (char *) "linked variable is read-only"; } - valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName, NULL, TCL_GLOBAL_ONLY); + valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY); if (valueObj == NULL) { /* * This shouldn't ever happen. @@ -891,7 +891,7 @@ LinkTraceProc( if (GetInt(objv[i], varPtr)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have integer values"; + return (char *) "variable array must have integer values"; } } } else { @@ -959,7 +959,7 @@ LinkTraceProc( if (Tcl_GetBooleanFromObj(NULL, objv[i], varPtr) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have boolean value"; + return (char *) "variable array must have boolean value"; } } } else { @@ -978,10 +978,10 @@ LinkTraceProc( if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetInt(objv[i], &valueInt) - || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) { + || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have char value"; + return (char *) "variable array must have char value"; } linkPtr->lastValue.cPtr[i] = (char) valueInt; } @@ -1000,7 +1000,7 @@ LinkTraceProc( if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetInt(objv[i], &valueInt) - || !InRange(0, valueInt, (int)UCHAR_MAX)) { + || !InRange(0, valueInt, (int)UCHAR_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return (char *) @@ -1027,7 +1027,7 @@ LinkTraceProc( || !InRange(SHRT_MIN, valueInt, SHRT_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have short value"; + return (char *) "variable array must have short value"; } linkPtr->lastValue.sPtr[i] = (short) valueInt; } @@ -1046,10 +1046,10 @@ LinkTraceProc( if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { if (GetInt(objv[i], &valueInt) - || !InRange(0, valueInt, (int)USHRT_MAX)) { + || !InRange(0, valueInt, (int)USHRT_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) + return (char *) "variable array must have unsigned short value"; } linkPtr->lastValue.usPtr[i] = (unsigned short) valueInt; @@ -1073,7 +1073,7 @@ LinkTraceProc( || !InRange(0, valueWide, (Tcl_WideInt)UINT_MAX)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) + return (char *) "variable array must have unsigned int value"; } linkPtr->lastValue.uiPtr[i] = (unsigned int) valueWide; @@ -1095,7 +1095,7 @@ LinkTraceProc( if (GetUWide(objv[i], &valueUWide)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) + return (char *) "variable array must have unsigned wide int value"; } linkPtr->lastValue.uwPtr[i] = valueUWide; @@ -1115,10 +1115,10 @@ LinkTraceProc( for (i=0; i < objc; i++) { if (GetDouble(objv[i], &valueDouble) && !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX) - && !IsSpecial(valueDouble)) { + && !IsSpecial(valueDouble)) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have float value"; + return (char *) "variable array must have float value"; } linkPtr->lastValue.fPtr[i] = (float) valueDouble; } diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 0615361..1bb3587 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -39,36 +39,36 @@ #ifdef ENABLE_LIST_ASSERTS -#define LIST_ASSERT(cond) assert(cond) +#define LIST_ASSERT(cond_) assert(cond_) /* * LIST_INDEX_ASSERT is to catch errors with negative indices and counts * being passed AFTER validation. On Tcl9 length types are unsigned hence * the checks against LIST_MAX. On Tcl8 length types are signed hence the * also checks against 0. */ -#define LIST_INDEX_ASSERT(idxarg) \ - do { \ - Tcl_Size idx = (idxarg); /* To guard against ++ etc. */ \ - LIST_ASSERT(idx >= 0 && idx < LIST_MAX); \ +#define LIST_INDEX_ASSERT(idxarg_) \ + do { \ + Tcl_Size idx_ = (idxarg_); /* To guard against ++ etc. */ \ + LIST_ASSERT(idx_ >= 0 && idx_ < LIST_MAX); \ } while (0) /* Ditto for counts except upper limit is different */ -#define LIST_COUNT_ASSERT(countarg) \ - do { \ - Tcl_Size count = (countarg); /* To guard against ++ etc. */ \ - LIST_ASSERT(count >= 0 && count <= LIST_MAX); \ +#define LIST_COUNT_ASSERT(countarg_) \ + do { \ + Tcl_Size count_ = (countarg_); /* To guard against ++ etc. */ \ + LIST_ASSERT(count_ >= 0 && count_ <= LIST_MAX); \ } while (0) #else -#define LIST_ASSERT(cond) ((void) 0) -#define LIST_INDEX_ASSERT(idx) ((void) 0) -#define LIST_COUNT_ASSERT(count) ((void) 0) +#define LIST_ASSERT(cond_) ((void) 0) +#define LIST_INDEX_ASSERT(idx_) ((void) 0) +#define LIST_COUNT_ASSERT(count_) ((void) 0) #endif /* Checks for when caller should have already converted to internal list type */ -#define LIST_ASSERT_TYPE(listObj) \ - LIST_ASSERT(TclHasInternalRep((listObj), &tclListType)) +#define LIST_ASSERT_TYPE(listObj_) \ + LIST_ASSERT(TclHasInternalRep((listObj_), &tclListType)) /* * If ENABLE_LIST_INVARIANTS is enabled (-DENABLE_LIST_INVARIANTS from the @@ -78,10 +78,9 @@ * invoke ListRepValidate directly even without ENABLE_LIST_INVARIANTS. */ #ifdef ENABLE_LIST_INVARIANTS -#define LISTREP_CHECK(listRepPtr) \ - ListRepValidate(listRepPtr, __FILE__, __LINE__) +#define LISTREP_CHECK(listRepPtr_) ListRepValidate(listRepPtr_, __FILE__, __LINE__) #else -#define LISTREP_CHECK(listRepPtr) (void) 0 +#define LISTREP_CHECK(listRepPtr_) (void) 0 #endif /* @@ -112,40 +111,37 @@ #define LISTREP_SPACE_ONLY_BACK 0x00000008 #define LISTREP_SPACE_FAVOR_NONE \ (LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK) -#define LISTREP_SPACE_FLAGS \ +#define LISTREP_SPACE_FLAGS \ (LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK \ | LISTREP_SPACE_ONLY_BACK) /* * Prototypes for non-inline static functions defined later in this file: */ -static int MemoryAllocationError(Tcl_Interp *, size_t size); -static int ListLimitExceededError(Tcl_Interp *); -static ListStore * ListStoreNew(Tcl_Size objc, Tcl_Obj *const objv[], - int flags); -static int ListRepInit(Tcl_Size objc, Tcl_Obj *const objv[], - int flags, ListRep *); -static int ListRepInitAttempt(Tcl_Interp *, - Tcl_Size objc, Tcl_Obj *const objv[], ListRep *); -static void ListRepClone(ListRep *fromRepPtr, ListRep *toRepPtr, - int flags); -static void ListRepUnsharedFreeUnreferenced(const ListRep *repPtr); -static int TclListObjGetRep(Tcl_Interp *, Tcl_Obj *listPtr, - ListRep *repPtr); -static void ListRepRange(ListRep *srcRepPtr, - Tcl_Size rangeStart, - Tcl_Size rangeEnd, - int preserveSrcRep, - ListRep *rangeRepPtr); -static ListStore * ListStoreReallocate(ListStore *storePtr, - Tcl_Size numSlots); -static void ListRepValidate(const ListRep *repPtr, - const char *file, int lineNum); -static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void FreeListInternalRep(Tcl_Obj *listPtr); -static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -static void UpdateStringOfList(Tcl_Obj *listPtr); -static Tcl_Size ListLength(Tcl_Obj *listPtr); +static int MemoryAllocationError(Tcl_Interp *, size_t size); +static int ListLimitExceededError(Tcl_Interp *); +static ListStore *ListStoreNew(Tcl_Size objc, Tcl_Obj *const objv[], int flags); +static int ListRepInit(Tcl_Size objc, Tcl_Obj *const objv[], int flags, ListRep *); +static int ListRepInitAttempt(Tcl_Interp *, + Tcl_Size objc, + Tcl_Obj *const objv[], + ListRep *); +static void ListRepClone(ListRep *fromRepPtr, ListRep *toRepPtr, int flags); +static void ListRepUnsharedFreeUnreferenced(const ListRep *repPtr); +static int TclListObjGetRep(Tcl_Interp *, Tcl_Obj *listPtr, ListRep *repPtr); +static void ListRepRange(ListRep *srcRepPtr, + Tcl_Size rangeStart, + Tcl_Size rangeEnd, + int preserveSrcRep, + ListRep *rangeRepPtr); +static ListStore *ListStoreReallocate(ListStore *storePtr, Tcl_Size numSlots); +static void ListRepValidate(const ListRep *repPtr, const char *file, + int lineNum); +static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void FreeListInternalRep(Tcl_Obj *listPtr); +static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void UpdateStringOfList(Tcl_Obj *listPtr); +static Tcl_Size ListLength(Tcl_Obj *listPtr); /* * The structure below defines the list Tcl object type by means of functions @@ -164,26 +160,25 @@ const Tcl_ObjType tclListType = { }; /* Macros to manipulate the List internal rep */ -#define ListRepIncrRefs(repPtr) \ - do { \ - (repPtr)->storePtr->refCount++; \ - if ((repPtr)->spanPtr) { \ - (repPtr)->spanPtr->refCount++; \ - } \ +#define ListRepIncrRefs(repPtr_) \ + do { \ + (repPtr_)->storePtr->refCount++; \ + if ((repPtr_)->spanPtr) { \ + (repPtr_)->spanPtr->refCount++; \ + } \ } while (0) /* Returns number of free unused slots at the back of the ListRep's ListStore */ -#define ListRepNumFreeTail(repPtr) \ - ((repPtr)->storePtr->numAllocated \ - - ((repPtr)->storePtr->firstUsed + (repPtr)->storePtr->numUsed)) +#define ListRepNumFreeTail(repPtr_) \ + ((repPtr_)->storePtr->numAllocated \ + - ((repPtr_)->storePtr->firstUsed + (repPtr_)->storePtr->numUsed)) /* Returns number of free unused slots at the front of the ListRep's ListStore */ -#define ListRepNumFreeHead(repPtr) \ - ((repPtr)->storePtr->firstUsed) +#define ListRepNumFreeHead(repPtr_) ((repPtr_)->storePtr->firstUsed) -/* Returns a pointer to the slot corresponding to list index listIdx */ -#define ListRepSlotPtr(repPtr, listIdx) \ - (&(repPtr)->storePtr->slots[ListRepStart(repPtr) + (listIdx)]) +/* Returns a pointer to the slot corresponding to list index listIdx_ */ +#define ListRepSlotPtr(repPtr_, listIdx_) \ + (&(repPtr_)->storePtr->slots[ListRepStart(repPtr_) + (listIdx_)]) /* * Macros to replace the internal representation in a Tcl_Obj. There are @@ -204,26 +199,26 @@ const Tcl_ObjType tclListType = { * passed ListRep) and frees it first. Additionally invalidates the string * representation. Generally used when modifying a Tcl_Obj value. */ -#define ListObjStompRep(objPtr, repPtr) \ - do { \ - (objPtr)->internalRep.twoPtrValue.ptr1 = (repPtr)->storePtr; \ - (objPtr)->internalRep.twoPtrValue.ptr2 = (repPtr)->spanPtr; \ - (objPtr)->typePtr = &tclListType; \ +#define ListObjStompRep(objPtr_, repPtr_) \ + do { \ + (objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \ + (objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr; \ + (objPtr_)->typePtr = &tclListType; \ } while (0) -#define ListObjOverwriteRep(objPtr, repPtr) \ - do { \ - ListRepIncrRefs(repPtr); \ - ListObjStompRep(objPtr, repPtr); \ +#define ListObjOverwriteRep(objPtr_, repPtr_) \ + do { \ + ListRepIncrRefs(repPtr_); \ + ListObjStompRep(objPtr_, repPtr_); \ } while (0) -#define ListObjReplaceRepAndInvalidate(objPtr, repPtr) \ - do { \ - /* Note order important, don't use ListObjOverwriteRep! */ \ - ListRepIncrRefs(repPtr); \ - TclFreeInternalRep(objPtr); \ - TclInvalidateStringRep(objPtr); \ - ListObjStompRep(objPtr, repPtr); \ +#define ListObjReplaceRepAndInvalidate(objPtr_, repPtr_) \ + do { \ + /* Note order important, don't use ListObjOverwriteRep! */ \ + ListRepIncrRefs(repPtr_); \ + TclFreeInternalRep(objPtr_); \ + TclInvalidateStringRep(objPtr_); \ + ListObjStompRep(objPtr_, repPtr_); \ } while (0) /* @@ -244,8 +239,8 @@ const Tcl_ObjType tclListType = { */ static inline ListSpan * ListSpanNew( - Tcl_Size firstSlot, /* Starting slot index of the span */ - Tcl_Size numSlots) /* Number of slots covered by the span */ + Tcl_Size firstSlot, /* Starting slot index of the span */ + Tcl_Size numSlots) /* Number of slots covered by the span */ { ListSpan *spanPtr = (ListSpan *) Tcl_Alloc(sizeof(*spanPtr)); spanPtr->refCount = 0; @@ -271,8 +266,7 @@ ListSpanNew( *------------------------------------------------------------------------ */ static inline void -ListSpanDecrRefs( - ListSpan *spanPtr) +ListSpanDecrRefs(ListSpan *spanPtr) { if (spanPtr->refCount <= 1) { Tcl_Free(spanPtr); @@ -303,10 +297,9 @@ ListSpanDecrRefs( */ static inline int ListSpanMerited( - Tcl_Size length, /* Length of the proposed span. */ - Tcl_Size usedStorageLength, /* Number of slots currently in use. */ - Tcl_Size allocatedStorageLength) - /* Length of the current allocation. */ + Tcl_Size length, /* Length of the proposed span */ + Tcl_Size usedStorageLength, /* Number of slots currently in used */ + Tcl_Size allocatedStorageLength) /* Length of the currently allocation */ { /* * Possible optimizations for future consideration @@ -350,8 +343,7 @@ ListSpanMerited( *------------------------------------------------------------------------ */ static inline void -ListRepFreeUnreferenced( - const ListRep *repPtr) +ListRepFreeUnreferenced(const ListRep *repPtr) { if (! ListRepIsShared(repPtr) && repPtr->spanPtr) { /* T:listrep-1.5.1 */ @@ -376,9 +368,9 @@ ListRepFreeUnreferenced( */ static inline void ObjArrayIncrRefs( - Tcl_Obj *const *objv, /* Pointer to the array */ - Tcl_Size startIdx, /* Starting index of subarray within objv */ - Tcl_Size count) /* Number of elements in the subarray */ + Tcl_Obj * const *objv, /* Pointer to the array */ + Tcl_Size startIdx, /* Starting index of subarray within objv */ + Tcl_Size count) /* Number of elements in the subarray */ { Tcl_Obj *const *end; LIST_INDEX_ASSERT(startIdx); @@ -408,9 +400,9 @@ ObjArrayIncrRefs( */ static inline void ObjArrayDecrRefs( - Tcl_Obj *const *objv, /* Pointer to the array */ - Tcl_Size startIdx, /* Starting index of subarray within objv */ - Tcl_Size count) /* Number of elements in the subarray */ + Tcl_Obj * const *objv, /* Pointer to the array */ + Tcl_Size startIdx, /* Starting index of subarray within objv */ + Tcl_Size count) /* Number of elements in the subarray */ { Tcl_Obj * const *end; LIST_INDEX_ASSERT(startIdx); @@ -440,9 +432,9 @@ ObjArrayDecrRefs( */ static inline void ObjArrayCopy( - Tcl_Obj **to, /* Destination */ - Tcl_Size count, /* Number of pointers to copy */ - Tcl_Obj *const from[]) /* Source array of Tcl_Obj* */ + Tcl_Obj **to, /* Destination */ + Tcl_Size count, /* Number of pointers to copy */ + Tcl_Obj *const from[]) /* Source array of Tcl_Obj* */ { Tcl_Obj **end; LIST_COUNT_ASSERT(count); @@ -471,8 +463,8 @@ ObjArrayCopy( */ static int MemoryAllocationError( - Tcl_Interp *interp, /* Interpreter for error message. May be NULL */ - size_t size) /* Size of attempted allocation that failed */ + Tcl_Interp *interp, /* Interpreter for error message. May be NULL */ + size_t size) /* Size of attempted allocation that failed */ { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -500,12 +492,12 @@ MemoryAllocationError( *------------------------------------------------------------------------ */ static int -ListLimitExceededError( - Tcl_Interp *interp) +ListLimitExceededError(Tcl_Interp *interp) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "max length of a Tcl list exceeded", -1)); + Tcl_SetObjResult( + interp, + Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); } return TCL_ERROR; @@ -531,9 +523,7 @@ ListLimitExceededError( *------------------------------------------------------------------------ */ static inline void -ListRepUnsharedShiftDown( - ListRep *repPtr, - Tcl_Size shiftCount) +ListRepUnsharedShiftDown(ListRep *repPtr, Tcl_Size shiftCount) { ListStore *storePtr; @@ -588,9 +578,7 @@ ListRepUnsharedShiftDown( */ #if 0 static inline void -ListRepUnsharedShiftUp( - ListRep *repPtr, - Tcl_Size shiftCount) +ListRepUnsharedShiftUp(ListRep *repPtr, Tcl_Size shiftCount) { ListStore *storePtr; @@ -636,22 +624,19 @@ ListRepUnsharedShiftUp( *------------------------------------------------------------------------ */ static void -ListRepValidate( - const ListRep *repPtr, - const char *file, - int lineNum) +ListRepValidate(const ListRep *repPtr, const char *file, int lineNum) { ListStore *storePtr = repPtr->storePtr; const char *condition; (void)storePtr; /* To stop gcc from whining about unused vars */ -#define INVARIANT(cond) \ - do { \ - if (!(cond)) { \ - condition = #cond; \ - goto failure; \ - } \ +#define INVARIANT(cond_) \ + do { \ + if (!(cond_)) { \ + condition = #cond_; \ + goto failure; \ + } \ } while (0) /* Separate each condition so line number gives exact reason for failure */ @@ -682,7 +667,9 @@ ListRepValidate( failure: Tcl_Panic("List internal failure in %s line %d. Condition: %s", - file, lineNum, condition); + file, + lineNum, + condition); } /* @@ -702,9 +689,7 @@ failure: *------------------------------------------------------------------------ */ void -TclListObjValidate( - Tcl_Interp *interp, - Tcl_Obj *listObj) +TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj) { ListRep listRep; if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { @@ -724,14 +709,14 @@ TclListObjValidate( * in that array. If objv==NULL, initalize 0 elements, with space * to add objc more. * - * Normally the function allocates the exact space requested unless - * the flags arguments has any LISTREP_SPACE_* - * bits set. See the comments for those #defines. + * Normally the function allocates the exact space requested unless + * the flags arguments has any LISTREP_SPACE_* + * bits set. See the comments for those #defines. * * Results: - * On success, a pointer to the allocated ListStore is returned. - * On allocation failure, panics if LISTREP_PANIC_ON_FAIL is set in - * flags; otherwise returns NULL. + * On success, a pointer to the allocated ListStore is returned. + * On allocation failure, panics if LISTREP_PANIC_ON_FAIL is set in + * flags; otherwise returns NULL. * * Side effects: * The ref counts of the elements in objv are incremented on success @@ -855,24 +840,24 @@ ListStoreReallocate( * * ListRepInit -- * - * Initializes a ListRep to hold a list internal representation - * with space for objc elements. + * Initializes a ListRep to hold a list internal representation + * with space for objc elements. * - * objc must be > 0. If objv!=NULL, initializes with the first objc - * values in that array. If objv==NULL, initalize list internal rep to - * have 0 elements, with space to add objc more. + * objc must be > 0. If objv!=NULL, initializes with the first objc + * values in that array. If objv==NULL, initalize list internal rep to + * have 0 elements, with space to add objc more. * * Normally the function allocates the exact space requested unless * the flags arguments has one of the LISTREP_SPACE_* bits set. * See the comments for those #defines. * - * The reference counts of the ListStore and ListSpan (if present) + * The reference counts of the ListStore and ListSpan (if present) * pointed to by the initialized repPtr are set to zero. * Caller has to manage them as necessary. * * Results: - * On success, TCL_OK is returned with *listRepPtr initialized. - * On failure, panics if LISTREP_PANIC_ON_FAIL is set in flags; otherwise + * On success, TCL_OK is returned with *listRepPtr initialized. + * On failure, panics if LISTREP_PANIC_ON_FAIL is set in flags; otherwise * returns TCL_ERROR with *listRepPtr fields set to NULL. * * Side effects: @@ -920,12 +905,12 @@ ListRepInit( * be > 0). This function only adds error messages to the interpreter if * not NULL. * - * The reference counts of the ListStore and ListSpan (if present) + * The reference counts of the ListStore and ListSpan (if present) * pointed to by the initialized repPtr are set to zero. * Caller has to manage them as necessary. * * Results: - * On success, TCL_OK is returned with *listRepPtr initialized. + * On success, TCL_OK is returned with *listRepPtr initialized. * On allocation failure, returnes TCL_ERROR with an error message * in the interpreter if non-NULL. * @@ -1256,16 +1241,16 @@ TclNewListObj2( * Side effects: * The possible conversion of the object referenced by listPtr * to a list object. *repPtr is initialized to the internal rep - * if result is TCL_OK, or set to NULL on error. + * if result is TCL_OK, or set to NULL on error. *---------------------------------------------------------------------- */ static int TclListObjGetRep( - Tcl_Interp *interp, /* Used to report errors if not NULL. */ - Tcl_Obj *listObj, /* List object for which an element array is - * to be returned. */ - ListRep *repPtr) /* Location to store descriptor */ + Tcl_Interp *interp, /* Used to report errors if not NULL. */ + Tcl_Obj *listObj, /* List object for which an element array is + * to be returned. */ + ListRep *repPtr) /* Location to store descriptor */ { if (!TclHasInternalRep(listObj, &tclListType)) { int result; @@ -1388,18 +1373,18 @@ TclListObjCopy( * None. * * Side effects: - * The ListStore and ListSpan referenced by in the returned ListRep - * may or may not be the same as those passed in. For example, the - * ListStore may differ because the range is small enough that a new - * ListStore is more memory-optimal. The ListSpan may differ because - * it is NULL or shared. Regardless, reference counts on the returned - * values are not incremented. Generally, ListObjReplaceRepAndInvalidate - * may be used to store the new ListRep back into an object or a - * ListRepIncrRefs followed by ListRepDecrRefs to free in case of errors. + * The ListStore and ListSpan referenced by in the returned ListRep + * may or may not be the same as those passed in. For example, the + * ListStore may differ because the range is small enough that a new + * ListStore is more memory-optimal. The ListSpan may differ because + * it is NULL or shared. Regardless, reference counts on the returned + * values are not incremented. Generally, ListObjReplaceRepAndInvalidate + * may be used to store the new ListRep back into an object or a + * ListRepIncrRefs followed by ListRepDecrRefs to free in case of errors. * Any other use should be carefully reconsidered. - * TODO WARNING:- this is an awkward interface and easy for caller - * to get wrong. Mostly due to refcount combinations. Perhaps passing - * in the source listObj instead of source listRep might simplify. + * TODO WARNING:- this is an awkward interface and easy for caller + * to get wrong. Mostly due to refcount combinations. Perhaps passing + * in the source listObj instead of source listRep might simplify. * *------------------------------------------------------------------------ */ @@ -1544,7 +1529,7 @@ ListRepRange( } memmove(&srcRepPtr->storePtr->slots[0], &srcRepPtr->storePtr - ->slots[srcRepPtr->storePtr->firstUsed + rangeStart], + ->slots[srcRepPtr->storePtr->firstUsed + rangeStart], rangeLen * sizeof(Tcl_Obj *)); srcRepPtr->storePtr->firstUsed = 0; srcRepPtr->storePtr->numUsed = rangeLen; @@ -1572,11 +1557,11 @@ ListRepRange( * TclListObjRange -- * * Makes a slice of a list value. - * *listObj must be known to be a valid list. + * *listObj must be known to be a valid list. * * Results: * Returns a pointer to the sliced list. - * This may be a new object or the same object if not shared. + * This may be a new object or the same object if not shared. * Returns NULL if passed listObj was not a list and could not be * converted to one. * @@ -1741,9 +1726,9 @@ Tcl_ListObjAppendList( * * TclListObjAppendElements -- * - * Appends multiple elements to a Tcl_Obj list object. If - * the passed Tcl_Obj is not a list object, it will be converted to one - * and an error raised if the conversion fails. + * Appends multiple elements to a Tcl_Obj list object. If + * the passed Tcl_Obj is not a list object, it will be converted to one + * and an error raised if the conversion fails. * * The Tcl_Obj must not be shared though the internal representation * may be. @@ -1973,7 +1958,7 @@ Tcl_ListObjIndex( return TCL_OK; } - int hasAbstractList = TclObjTypeHasProc(listObj, indexProc) != 0; + int hasAbstractList = TclObjTypeHasProc(listObj,indexProc) != 0; if (hasAbstractList) { return TclObjTypeIndex(interp, listObj, index, objPtrPtr); } @@ -2015,9 +2000,9 @@ Tcl_ListObjIndex( #undef Tcl_ListObjLength int Tcl_ListObjLength( - Tcl_Interp *interp, /* Used to report errors if not NULL. */ - Tcl_Obj *listObj, /* List object whose #elements to return. */ - Tcl_Size *lenPtr) /* The resulting length is stored here. */ + Tcl_Interp *interp, /* Used to report errors if not NULL. */ + Tcl_Obj *listObj, /* List object whose #elements to return. */ + Tcl_Size *lenPtr) /* The resulting length is stored here. */ { ListRep listRep; @@ -2756,7 +2741,7 @@ TclLindexFlat( * * Core of the 'lset' command when objc == 4. Objv[2] may be either a * scalar index or a list of indices. - * It also handles 'lpop' when given a NULL value. + * It also handles 'lpop' when given a NULL value. * * Results: * Returns the new value of the list variable, or NULL if there was an @@ -2782,10 +2767,10 @@ TclLsetList( Tcl_Obj *indexArgObj, /* Index or index-list arg to 'lset'. */ Tcl_Obj *valueObj) /* Value arg to 'lset' or NULL to 'lpop'. */ { - Tcl_Size indexCount = 0; /* Number of indices in the index list. */ + Tcl_Size indexCount = 0; /* Number of indices in the index list. */ Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */ Tcl_Obj *retValueObj; /* Pointer to the list to be returned. */ - Tcl_Size index; /* Current index in the list - discarded. */ + Tcl_Size index; /* Current index in the list - discarded. */ Tcl_Obj *indexListCopy; /* @@ -2812,7 +2797,7 @@ TclLsetList( } else { - indexListCopy = TclListObjCopy(NULL, indexArgObj); + indexListCopy = TclListObjCopy(NULL,indexArgObj); if (!indexListCopy) { /* * indexArgPtr designates something that is neither an index nor a @@ -2851,7 +2836,7 @@ TclLsetList( * TclLsetFlat -- * * Core engine of the 'lset' command. - * It also handles 'lpop' when given a NULL value. + * It also handles 'lpop' when given a NULL value. * * Results: * Returns the new value of the list variable, or NULL if an error @@ -2972,11 +2957,11 @@ TclLsetFlat( } indexArray++; - /* - * Special case 0-length lists. The Tcl indexing function treat - * will return any value beyond length as TCL_SIZE_MAX for this - * case. - */ + /* + * Special case 0-length lists. The Tcl indexing function treat + * will return any value beyond length as TCL_SIZE_MAX for this + * case. + */ if ((index == TCL_SIZE_MAX) && (elemCount == 0)) { index = 0; } @@ -2986,7 +2971,7 @@ TclLsetFlat( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "index \"%s\" out of range", - Tcl_GetString(indexArray[-1]))); + Tcl_GetString(indexArray[-1]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" "OUTOFRANGE", (void *)NULL); } @@ -3158,7 +3143,7 @@ TclListObjSetElement( * element. */ { ListRep listRep; - Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */ + Tcl_Obj **elemPtrs; /* Pointers to elements of the list. */ Tcl_Size elemCount; /* Number of elements in the list. */ /* Ensure that the listObj parameter designates an unshared list. */ @@ -3350,7 +3335,7 @@ SetListFromAny( Tcl_IncrRefCount(valuePtr); Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } - } else if (TclObjTypeHasProc(objPtr, indexProc)) { + } else if (TclObjTypeHasProc(objPtr,indexProc)) { Tcl_Size elemCount, i; elemCount = TclObjTypeLength(objPtr); diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index a2a90d6..f4d92cd 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -58,7 +58,8 @@ static void RebuildLiteralTable(LiteralTable *tablePtr); void TclInitLiteralTable( - LiteralTable *tablePtr) /* Pointer to table structure, which is + LiteralTable *tablePtr) + /* Pointer to table structure, which is * supplied by the caller. */ { #if (TCL_SMALL_HASH_TABLE != 4) @@ -175,11 +176,11 @@ TclDeleteLiteralTable( Tcl_Obj * TclCreateLiteral( Interp *iPtr, - const char *bytes, /* The start of the string. Note that this is + const char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ - Tcl_Size length, /* Number of bytes in the string. */ - size_t hash, /* The string's hash. If the value is - * TCL_INDEX_NONE, it will be computed here. */ + Tcl_Size length, /* Number of bytes in the string. */ + size_t hash, /* The string's hash. If the value is + * TCL_INDEX_NONE, it will be computed here. */ int *newPtr, Namespace *nsPtr, int flags, @@ -388,12 +389,12 @@ TclFetchLiteral( int /* Do NOT change this type. Should not be wider than TclEmitPush operand*/ TclRegisterLiteral( - void *ePtr, /* Points to the CompileEnv in whose object + 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 + const char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ - Tcl_Size length, /* Number of bytes in the string. If -1, the + Tcl_Size length, /* Number of bytes in the string. If -1, the * string consists of all bytes up to the * first null character. */ int flags) /* If LITERAL_ON_HEAP then the caller already @@ -506,7 +507,7 @@ 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 + Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal * that was previously created by a call to * TclRegisterLiteral. */ { @@ -552,7 +553,7 @@ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - CompileEnv *envPtr, /* Points to CompileEnv whose literal array + CompileEnv *envPtr,/* Points to CompileEnv whose literal array * contains the entry being hidden. */ int index) /* The index of the entry in the literal * array. */ @@ -616,7 +617,7 @@ TclHideLiteral( int TclAddLiteralObj( - CompileEnv *envPtr, /* Points to CompileEnv in whose literal array + 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 @@ -669,7 +670,7 @@ TclAddLiteralObj( static size_t AddLocalLiteralEntry( - CompileEnv *envPtr, /* Points to CompileEnv in whose literal array + 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. */ @@ -747,7 +748,7 @@ AddLocalLiteralEntry( static void ExpandLocalLiteralArray( - CompileEnv *envPtr) /* Points to the CompileEnv whose object array + CompileEnv *envPtr)/* Points to the CompileEnv whose object array * must be enlarged. */ { /* @@ -829,7 +830,7 @@ 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 + Tcl_Obj *objPtr) /* Points to a literal object that was * previously created by a call to * TclRegisterLiteral. */ { @@ -909,8 +910,8 @@ TclReleaseLiteral( static size_t HashString( - const char *string, /* String for which to compute hash value. */ - size_t length) /* Number of bytes in the string. */ + const char *string, /* String for which to compute hash value. */ + size_t length) /* Number of bytes in the string. */ { size_t result = 0; @@ -973,7 +974,8 @@ HashString( static void RebuildLiteralTable( - LiteralTable *tablePtr) /* Local or global table to enlarge. */ + LiteralTable *tablePtr) + /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; LiteralEntry **oldChainPtr, **newChainPtr; diff --git a/generic/tclLoad.c b/generic/tclLoad.c index b336f5c..c5a181d 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -156,8 +156,7 @@ Tcl_LoadObjCmd( &index) != TCL_OK) { return TCL_ERROR; } - ++objv; - --objc; + ++objv; --objc; if (LOAD_GLOBAL == index) { flags |= TCL_LOAD_GLOBAL; } else if (LOAD_LAZY == index) { @@ -994,7 +993,7 @@ Tcl_StaticLibrary( * already been loaded into the given * interpreter by calling the appropriate init * proc. */ - const char *prefix, /* Prefix. */ + const char *prefix, /* Prefix. */ Tcl_LibraryInitProc *initProc, /* Function to call to incorporate this * library into a trusted interpreter. */ @@ -1186,7 +1185,7 @@ TclGetLoadedLibraries( static void LoadCleanupProc( - TCL_UNUSED(void *), /* Pointer to first InterpLibrary structure + TCL_UNUSED(void *), /* Pointer to first InterpLibrary structure * for interp. */ Tcl_Interp *interp) { @@ -1199,7 +1198,7 @@ LoadCleanupProc( break; } libraryPtr = ipPtr->libraryPtr; - UnloadLibrary(interp, interp, libraryPtr, 0, "", 1); + UnloadLibrary(interp, interp, libraryPtr, 0 ,"", 1); } } diff --git a/generic/tclMain.c b/generic/tclMain.c index a9af9d7..a7cb7fb 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -276,7 +276,7 @@ Tcl_SourceRCFile( TCL_NORETURN void Tcl_MainEx( - Tcl_Size argc, /* Number of arguments. */ + Tcl_Size argc, /* Number of arguments. */ TCHAR **argv, /* Array of argument strings. */ Tcl_AppInitProc *appInitProc, /* Application-specific initialization @@ -739,7 +739,7 @@ TclFullFinalizationRequested(void) static void StdinProc( - void *clientData, /* The state of interactive cmd line */ + void *clientData, /* The state of interactive cmd line */ TCL_UNUSED(int) /*mask*/) { int code; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 24eb14e..eebf6aa 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -77,9 +77,9 @@ static int DoImport(Tcl_Interp *interp, const char *cmdName, const char *pattern, Namespace *importNsPtr, int allowOverwrite); static void DupNsNameInternalRep(Tcl_Obj *objPtr,Tcl_Obj *copyPtr); -static char * ErrorCodeRead(void *clientData, Tcl_Interp *interp, +static char * ErrorCodeRead(void *clientData,Tcl_Interp *interp, const char *name1, const char *name2, int flags); -static char * ErrorInfoRead(void *clientData, Tcl_Interp *interp, +static char * ErrorInfoRead(void *clientData,Tcl_Interp *interp, const char *name1, const char *name2, int flags); static char * EstablishErrorCodeTraces(void *clientData, Tcl_Interp *interp, const char *name1, @@ -90,7 +90,8 @@ static char * EstablishErrorInfoTraces(void *clientData, static void FreeNsNameInternalRep(Tcl_Obj *objPtr); static int GetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); -static Tcl_ObjCmdProc InvokeImportedNRCmd; +static int InvokeImportedNRCmd(void *clientData, + Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static Tcl_ObjCmdProc NamespaceChildrenCmd; static Tcl_ObjCmdProc NamespaceCodeCmd; static Tcl_ObjCmdProc NamespaceCurrentCmd; @@ -652,7 +653,7 @@ Tcl_CreateNamespace( const char *name, /* Name for the new namespace. May be a * qualified name with names of ancestor * namespaces separated by "::"s. */ - void *clientData, /* One-word value to store with namespace. */ + void *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 @@ -1177,7 +1178,7 @@ TclDeleteNamespaceChildren( void TclTeardownNamespace( - Namespace *nsPtr) /* Points to the namespace to be dismantled + Namespace *nsPtr) /* Points to the namespace to be dismantled * and unlinked from its parent. */ { Interp *iPtr = (Interp *) nsPtr->interp; @@ -1315,7 +1316,7 @@ TclTeardownNamespace( static void NamespaceFree( - Namespace *nsPtr) /* Points to the namespace to free. */ + Namespace *nsPtr) /* Points to the namespace to free. */ { /* * Most of the namespace's contents are freed when the namespace is @@ -1614,7 +1615,7 @@ Tcl_Import( * want absence of the command to be a failure case. */ - if (Tcl_FindCommand(interp, "auto_import", NULL, TCL_GLOBAL_ONLY) != NULL) { + if (Tcl_FindCommand(interp,"auto_import",NULL,TCL_GLOBAL_ONLY) != NULL) { Tcl_Obj *objv[2]; int result; @@ -1639,7 +1640,7 @@ Tcl_Import( */ if (strlen(pattern) == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1)); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", (char *)NULL); return TCL_ERROR; } @@ -2034,7 +2035,7 @@ TclGetOriginalCommand( static int InvokeImportedNRCmd( - void *clientData, /* Points to the imported command's + void *clientData, /* Points to the imported command's * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -2049,7 +2050,7 @@ InvokeImportedNRCmd( int TclInvokeImportedCmd( - void *clientData, /* Points to the imported command's + void *clientData, /* Points to the imported command's * ImportedCmdData structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -2082,7 +2083,7 @@ TclInvokeImportedCmd( static void DeleteImportedCmd( - void *clientData) /* Points to the imported command's + void *clientData) /* Points to the imported command's * ImportedCmdData structure. */ { ImportedCmdData *dataPtr = (ImportedCmdData *)clientData; @@ -2521,7 +2522,7 @@ Tcl_FindNamespace( * 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 + int flags) /* Flags controlling namespace lookup: an OR'd * combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG flags. */ { @@ -3368,7 +3369,7 @@ NamespaceDeleteCmd( static int NamespaceEvalCmd( - void *clientData, /* Arbitrary value passed to cmd. */ + void *clientData, /* Arbitrary value passed to cmd. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3757,7 +3758,7 @@ NamespaceImportCmd( if (cmdPtr->deleteProc == DeleteImportedCmd) { Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj( - (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr), -1)); + (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1)); } } Tcl_SetObjResult(interp, listPtr); @@ -3817,7 +3818,7 @@ NamespaceImportCmd( static int NamespaceInscopeCmd( - void *clientData, /* Arbitrary value passed to cmd. */ + void *clientData, /* Arbitrary value passed to cmd. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -4690,7 +4691,7 @@ NamespaceWhichCmd( TclNewObj(resultPtr); switch (lookupType) { case 0: { /* -command */ - Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc - 1]); + Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]); if (cmd != NULL) { Tcl_GetCommandFullName(interp, cmd, resultPtr); @@ -4699,7 +4700,7 @@ NamespaceWhichCmd( } case 1: { /* -variable */ Tcl_Var var = Tcl_FindNamespaceVar(interp, - TclGetString(objv[objc - 1]), NULL, /*flags*/ 0); + TclGetString(objv[objc-1]), NULL, /*flags*/ 0); if (var != NULL) { Tcl_GetVariableFullName(interp, var, resultPtr); @@ -4732,7 +4733,7 @@ NamespaceWhichCmd( static void FreeNsNameInternalRep( - Tcl_Obj *objPtr) /* nsName object with internal representation + Tcl_Obj *objPtr) /* nsName object with internal representation * to free. */ { ResolvedNsName *resNamePtr; @@ -4779,7 +4780,7 @@ FreeNsNameInternalRep( static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedNsName *resNamePtr; @@ -4815,7 +4816,7 @@ 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. */ + Tcl_Obj *objPtr) /* The object to convert. */ { const char *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; @@ -4828,7 +4829,7 @@ SetNsNameFromAny( name = TclGetString(objPtr); TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS, - &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); + &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) { return TCL_ERROR; diff --git a/generic/tclNotify.c b/generic/tclNotify.c index dd0a0be..ec24a4b 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -71,7 +71,7 @@ typedef struct ThreadSpecificData { /* Pointer to first event source in list of * event sources for this thread. */ Tcl_ThreadId threadId; /* Thread that owns this notifier instance. */ - void *clientData; /* Opaque handle for platform specific + void *clientData; /* Opaque handle for platform specific * notifier. */ int initialized; /* 1 if notifier has been initialized. */ struct ThreadSpecificData *nextPtr; @@ -305,7 +305,7 @@ Tcl_CreateEventSource( Tcl_EventCheckProc *checkProc, /* Function to call after waiting to see what * happened. */ - void *clientData) /* One-word argument to pass to setupProc and + void *clientData) /* One-word argument to pass to setupProc and * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -344,7 +344,7 @@ Tcl_DeleteEventSource( Tcl_EventCheckProc *checkProc, /* Function to call after waiting to see what * happened. */ - void *clientData) /* One-word argument to pass to setupProc and + void *clientData) /* One-word argument to pass to setupProc and * checkProc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -556,7 +556,7 @@ QueueEvent( void Tcl_DeleteEvents( Tcl_EventDeleteProc *proc, /* The function to call. */ - void *clientData) /* The type-specific data. */ + void *clientData) /* The type-specific data. */ { Tcl_Event *evPtr; /* Pointer to the event being examined */ Tcl_Event *prevPtr; /* Pointer to evPtr's predecessor, or NULL if @@ -1253,7 +1253,7 @@ Tcl_FinalizeNotifier( void Tcl_AlertNotifier( - void *clientData) /* Pointer to thread data. */ + void *clientData) /* Pointer to thread data. */ { if (tclNotifierHooks.alertNotifierProc) { tclNotifierHooks.alertNotifierProc(clientData); @@ -1310,7 +1310,7 @@ Tcl_ServiceModeHook( void Tcl_SetTimer( - const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ + const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { if (tclNotifierHooks.setTimerProc) { tclNotifierHooks.setTimerProc(timePtr); @@ -1341,7 +1341,7 @@ Tcl_SetTimer( int Tcl_WaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { if (tclNotifierHooks.waitForEventProc) { return tclNotifierHooks.waitForEventProc(timePtr); @@ -1380,7 +1380,7 @@ Tcl_CreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { if (tclNotifierHooks.createFileHandlerProc) { tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData); diff --git a/generic/tclOO.c b/generic/tclOO.c index 9229c08..6074147 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -104,9 +104,9 @@ static void MyClassDeleted(void *clientData); * Note that the core methods don't need clone or free proc callbacks. */ -#define DCM(name, visibility, proc) \ - {name, visibility, \ - {TCL_OO_METHOD_VERSION_CURRENT, "core method: "#name, proc, NULL, NULL}} +#define DCM(name,visibility,proc) \ + {name,visibility,\ + {TCL_OO_METHOD_VERSION_CURRENT,"core method: "#name,proc,NULL,NULL}} static const DeclaredClassMethod objMethods[] = { DCM("destroy", 1, TclOO_Object_Destroy), @@ -180,9 +180,9 @@ MODULE_SCOPE const TclOOStubs tclOOStubs; #define IsRootClass(ocPtr) ((ocPtr)->flags & ROOT_CLASS) #define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS)) -#define RemoveItem(type, lst, idx) \ +#define RemoveItem(type, lst, i) \ do { \ - Remove ## type ((lst).list, (lst).num, idx); \ + Remove ## type ((lst).list, (lst).num, i); \ (lst).num--; \ } while (0) @@ -415,7 +415,7 @@ InitFoundation( NULL); Tcl_CreateObjCommand(interp, "::oo::objdefine", TclOOObjDefObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL,NULL); TclOOInitInfo(interp); /* @@ -576,8 +576,8 @@ DeletedHelpersNamespace( static void KillFoundation( TCL_UNUSED(void *), - Tcl_Interp *interp) /* The interpreter containing the OO system - * foundation. */ + Tcl_Interp *interp) /* The interpreter containing the OO system + * foundation. */ { Foundation *fPtr = GetFoundation(interp); @@ -751,7 +751,7 @@ AllocObject( TclOOPrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted); oPtr->myclassCommand = TclNRCreateCommandInNs(interp, "myclass", oPtr->namespacePtr, TclOOMyClassObjCmd, MyClassNRObjCmd, oPtr, - MyClassDeleted); + MyClassDeleted); return oPtr; } @@ -791,7 +791,7 @@ SquelchCachedName( static void MyDeleted( - void *clientData) /* Reference to the object whose [my] has been + void *clientData) /* Reference to the object whose [my] has been * squelched. */ { Object *oPtr = (Object *)clientData; @@ -822,7 +822,7 @@ MyClassDeleted( static void ObjectRenamedTrace( - void *clientData, /* The object being deleted. */ + void *clientData, /* The object being deleted. */ TCL_UNUSED(Tcl_Interp *), TCL_UNUSED(const char *) /*oldName*/, TCL_UNUSED(const char *) /*newName*/, @@ -1135,7 +1135,7 @@ TclOOReleaseClassContents( static void ObjectNamespaceDeleted( - void *clientData) /* Pointer to the class whose namespace is + void *clientData) /* Pointer to the class whose namespace is * being deleted. */ { Object *oPtr = (Object *)clientData; @@ -1718,10 +1718,10 @@ Tcl_NewObjectInstance( const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - Tcl_Size objc, /* Number of arguments. Negative value means + Tcl_Size objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - Tcl_Size skip) /* Number of arguments to _not_ pass to the + Tcl_Size skip) /* Number of arguments to _not_ pass to the * constructor. */ { Class *classPtr = (Class *) cls; @@ -1786,10 +1786,10 @@ TclNRNewObjectInstance( const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - Tcl_Size objc, /* Number of arguments. Negative value means + Tcl_Size objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - Tcl_Size skip, /* Number of arguments to _not_ pass to the + Tcl_Size skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ @@ -2560,7 +2560,7 @@ TclOOPublicObjectCmd( int objc, Tcl_Obj *const *objv) { - return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData, objc, objv); + return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv); } static int @@ -2581,7 +2581,7 @@ TclOOPrivateObjectCmd( int objc, Tcl_Obj *const *objv) { - return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd, clientData, objc, objv); + return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv); } static int @@ -2607,7 +2607,7 @@ TclOOInvokeObject( * (PRIVATE_METHOD), or a *really* private * context (any other value; conventionally * 0). */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Array of argument objects. It is assumed * that the name of the method to invoke will * be at index 1. */ @@ -2678,7 +2678,7 @@ int TclOOObjectCmdCore( Object *oPtr, /* The object being invoked. */ Tcl_Interp *interp, /* The interpreter containing the object. */ - Tcl_Size objc, /* How many arguments are being passed in. */ + Tcl_Size objc, /* How many arguments are being passed in. */ Tcl_Obj *const *objv, /* The array of arguments. */ int flags, /* Whether this is an invocation through the * public or the private command interface. */ @@ -2813,7 +2813,7 @@ TclOOObjectCmdCore( * for the duration. */ - TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL, NULL, NULL); + TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL); return TclOOInvokeContext(contextPtr, interp, objc, objv); } diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index fd10339..11af6a2 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -896,7 +896,7 @@ TclOONextObjCmd( * that this is like [uplevel 1] and not [eval]. */ - TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL, NULL, NULL); + TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL); iPtr->varFramePtr = framePtr->callerVarPtr; return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1); } diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 6703a1f..46ee8be 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -25,7 +25,7 @@ struct ChainBuilder { CallChain *callChainPtr; /* The call chain being built. */ - size_t filterLength; /* Number of entries in the call chain that + size_t filterLength; /* Number of entries in the call chain that * are due to processing filters and not the * main call chain. */ Object *oPtr; /* The object that we are building the chain @@ -308,7 +308,7 @@ FreeMethodNameRep( int TclOOInvokeContext( - void *clientData, /* The method call context. */ + void *clientData, /* The method call context. */ Tcl_Interp *interp, /* Interpreter for error reporting, and many * other sorts of context handling (e.g., * commands, variables) depending on method @@ -357,9 +357,9 @@ TclOOInvokeContext( */ if (contextPtr->oPtr->flags & FILTER_HANDLING) { - TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL, NULL, NULL); + TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL); } else { - TclNRAddCallback(interp, ResetFilterFlags, contextPtr, NULL, NULL, NULL); + TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL); } if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) { contextPtr->oPtr->flags |= FILTER_HANDLING; @@ -677,7 +677,7 @@ CmpStr( static void AddClassMethodNames( Class *clsPtr, /* Class to get method names from. */ - int flags, /* Whether we are interested in just the + int flags, /* Whether we are interested in just the * public method names. */ Tcl_HashTable *const namesPtr, /* Reference to the hash table to put the @@ -2038,9 +2038,8 @@ AddSimpleClassDefineNamespaces( static inline void AddDefinitionNamespaceToChain( - Class *const definerCls, /* What class defines this entry. */ - Tcl_Obj *const namespaceName, - /* The name for this entry (or NULL, a + Class *const definerCls, /* What class defines this entry. */ + Tcl_Obj *const namespaceName, /* The name for this entry (or NULL, a * no-op). */ DefineChain *const definePtr, /* The define chain to add the method diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index e9efd6b..7bee39b 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -40,7 +40,7 @@ struct DeclaredSlot { const Tcl_MethodType resolverType; }; -#define SLOT(name, getter, setter, resolver) \ +#define SLOT(name,getter,setter,resolver) \ {"::oo::" name, \ {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \ getter, NULL, NULL}, \ @@ -2677,7 +2677,7 @@ ClassSuperSet( Tcl_SetObjResult(interp, Tcl_NewStringObj( "class should only be a direct superclass once", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",(char *)NULL); goto failedAfterAlloc; } } diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 6332539..031b910 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -46,8 +46,8 @@ typedef struct Method { /* The type of method. If NULL, this is a * special flag record which is just used for * the setting of the flags field. */ - Tcl_Size refCount; /* Reference counter for this structure. */ - void *clientData; /* Type-specific data. */ + Tcl_Size refCount; + void *clientData; /* Type-specific data. */ Tcl_Obj *namePtr; /* Name of the method. */ struct Object *declaringObjectPtr; /* The object that declares this method, or @@ -209,9 +209,9 @@ typedef struct Object { * references; this mechanism exists to * avoid Tcl_Preserve. */ int flags; - Tcl_Size creationEpoch; /* Unique value to make comparisons of objects + Tcl_Size creationEpoch; /* Unique value to make comparisons of objects * easier. */ - Tcl_Size epoch; /* Per-object epoch, incremented when the way + Tcl_Size epoch; /* Per-object epoch, incremented when the way * an object should resolve call chains is * changed. */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to @@ -519,16 +519,16 @@ MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr); MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp, Object *useThisObj); MODULE_SCOPE int TclMethodIsType(Tcl_Method method, - const Tcl_MethodType *typePtr, - void **clientDataPtr); + const Tcl_MethodType *typePtr, + void **clientDataPtr); MODULE_SCOPE Tcl_Method TclNewInstanceMethod(Tcl_Interp *interp, - Tcl_Object object, Tcl_Obj *nameObj, - int flags, const Tcl_MethodType *typePtr, - void *clientData); + Tcl_Object object, Tcl_Obj *nameObj, + int flags, const Tcl_MethodType *typePtr, + void *clientData); MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Interp *interp, Tcl_Class cls, - Tcl_Obj *nameObj, int flags, - const Tcl_MethodType *typePtr, - void *clientData); + Tcl_Obj *nameObj, int flags, + const Tcl_MethodType *typePtr, + void *clientData); MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, Tcl_Size objc, @@ -611,9 +611,9 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); * REQUIRES DECLARATION: Tcl_Size i; */ -#define FOREACH(var, ary) \ - for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \ - continue; \ +#define FOREACH(var,ary) \ + for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \ + continue; \ } else if ((var) = (ary).list[i], 1) /* @@ -623,7 +623,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); * REQUIRES DECLARATION: Tcl_Size i; See [96551aca55] for more FOREACH_STRUCT details. */ -#define FOREACH_STRUCT(var, ary) \ +#define FOREACH_STRUCT(var,ary) \ if (i=0, (ary).num>0) for(; var=&((ary).list[i]), i<(ary).num; i++) /* @@ -636,15 +636,13 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); #define FOREACH_HASH_DECLS \ Tcl_HashEntry *hPtr;Tcl_HashSearch search -#define FOREACH_HASH(key, val, tablePtr) \ - for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ - (*(void **)&(key)=Tcl_GetHashKey((tablePtr),hPtr), \ - *(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; \ - hPtr=Tcl_NextHashEntry(&search)) -#define FOREACH_HASH_VALUE(val, tablePtr) \ - for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ - (*(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; \ - hPtr=Tcl_NextHashEntry(&search)) +#define FOREACH_HASH(key,val,tablePtr) \ + for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ + (*(void **)&(key)=Tcl_GetHashKey((tablePtr),hPtr),\ + *(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search)) +#define FOREACH_HASH_VALUE(val,tablePtr) \ + for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \ + (*(void **)&(val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search)) /* * Convenience macro for duplicating a list. Needs no external declaration, @@ -652,15 +650,14 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); */ #undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */ -#define DUPLICATE(target, source, type) \ - do { \ - size_t len = sizeof(type) * ((target).num=(source).num); \ - if (len != 0) { \ - memcpy(((target).list=(type*) \ - Tcl_Alloc(len)), (source).list, len); \ - } else { \ - (target).list = NULL; \ - } \ +#define DUPLICATE(target,source,type) \ + do { \ + size_t len = sizeof(type) * ((target).num=(source).num);\ + if (len != 0) { \ + memcpy(((target).list=(type*)Tcl_Alloc(len)), (source).list, len); \ + } else { \ + (target).list = NULL; \ + } \ } while(0) #endif /* TCL_OO_INTERNAL_H */ diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 8ccaeb5..be51f0b 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -268,7 +268,7 @@ TclNewMethod( mPtr->refCount = 1; goto populate; } - hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, nameObj, &isNew); + hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, nameObj,&isNew); if (isNew) { mPtr = (Method *)Tcl_Alloc(sizeof(Method)); mPtr->refCount = 1; @@ -536,7 +536,7 @@ TclOOMakeProcInstanceMethod( * NULL. */ const Tcl_MethodType *typePtr, /* The type of the method to create. */ - void *clientData, /* The per-method type-specific data. */ + void *clientData, /* The per-method type-specific data. */ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the @@ -649,7 +649,7 @@ TclOOMakeProcMethod( * NULL. */ const Tcl_MethodType *typePtr, /* The type of the method to create. */ - void *clientData, /* The per-method type-specific data. */ + void *clientData, /* The per-method type-specific data. */ Proc **procPtrPtr) /* A pointer to the variable in which to write * the procedure record reference. Presumably * inside the structure indicated by the @@ -744,7 +744,7 @@ TclOOMakeProcMethod( static int InvokeProcedureMethod( - void *clientData, /* Pointer to some per-method context. */ + void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ @@ -1259,7 +1259,7 @@ RenderDeclarerName( /* TODO: Check whether Tcl_AppendLimitedToObj() can work here. */ #define LIMIT 60 -#define ELLIPSIFY(str, len) \ +#define ELLIPSIFY(str,len) \ ((len) > LIMIT ? LIMIT : (int)(len)), (str), ((len) > LIMIT ? "..." : "") static void @@ -1544,7 +1544,7 @@ TclOONewForwardMethod( static int InvokeForwardMethod( - void *clientData, /* Pointer to some per-method context. */ + void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ diff --git a/generic/tclObj.c b/generic/tclObj.c index aa36da6..36856d4 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -78,26 +78,26 @@ typedef struct { typedef struct { Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj - * generated by a call to the function - * TclSubstTokens() from a literal text - * where bs+nl sequences occurred in it, if - * any. I.e. this table keeps track of - * invisible and stripped continuation lines. - * Its keys are Tcl_Obj pointers, the values - * are ContLineLoc pointers. See the file - * tclCompile.h for the definition of this - * structure, and for references to all - * related places in the core. */ + * generated by a call to the function + * TclSubstTokens() from a literal text + * where bs+nl sequences occurred in it, if + * any. I.e. this table keeps track of + * invisible and stripped continuation lines. + * Its keys are Tcl_Obj pointers, the values + * are ContLineLoc pointers. See the file + * tclCompile.h for the definition of this + * structure, and for references to all + * related places in the core. */ #if TCL_THREADS && defined(TCL_MEM_DEBUG) Tcl_HashTable *objThreadMap;/* Thread local table that is used to check - * that a Tcl_Obj was not allocated by some - * other thread. */ + * that a Tcl_Obj was not allocated by some + * other thread. */ #endif /* TCL_MEM_DEBUG && TCL_THREADS */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -static void TclThreadFinalizeContLines(void *clientData); +static void TclThreadFinalizeContLines(void *clientData); static ThreadSpecificData *TclGetContLineTable(void); /* @@ -145,13 +145,13 @@ typedef struct PendingObjData { #define ObjDeletionUnlock(contextPtr) ((contextPtr)->deletionCount--) #define ObjDeletePending(contextPtr) ((contextPtr)->deletionCount > 0) #define ObjOnStack(contextPtr) ((contextPtr)->deletionStack != NULL) -#define PushObjToDelete(contextPtr, objPtr) \ +#define PushObjToDelete(contextPtr,objPtr) \ /* The string rep is already invalidated so we can use the bytes value \ - * for our pointer chain: push onto the head of the stack. */ \ - (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \ + * for our pointer chain: push onto the head of the stack. */ \ + (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \ (contextPtr)->deletionStack = (objPtr) -#define PopObjToDelete(contextPtr, objPtrVar) \ - (objPtrVar) = (contextPtr)->deletionStack; \ +#define PopObjToDelete(contextPtr,objPtrVar) \ + (objPtrVar) = (contextPtr)->deletionStack; \ (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes /* @@ -168,8 +168,8 @@ static __thread PendingObjData pendingObjData; #else static Tcl_ThreadDataKey pendingObjDataKey; #define ObjInitDeletionContext(contextPtr) \ - PendingObjData *const contextPtr = (PendingObjData *) \ - Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData)) + PendingObjData *const contextPtr = \ + (PendingObjData *)Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData)) #endif /* @@ -177,16 +177,15 @@ static Tcl_ThreadDataKey pendingObjDataKey; */ #define PACK_BIGNUM(bignum, objPtr) \ - if ((bignum).used > 0x7FFF) { \ - mp_int *temp = (mp_int *)Tcl_Alloc(sizeof(mp_int)); \ - *temp = bignum; \ - (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ - (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ - } else if (((bignum).alloc <= 0x7FFF) \ - || (mp_shrink(&(bignum))) == MP_OKAY) { \ - (objPtr)->internalRep.twoPtrValue.ptr1 = (bignum).dp; \ + if ((bignum).used > 0x7FFF) { \ + mp_int *temp = (mp_int *)Tcl_Alloc(sizeof(mp_int)); \ + *temp = bignum; \ + (objPtr)->internalRep.twoPtrValue.ptr1 = temp; \ + (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \ + } else if (((bignum).alloc <= 0x7FFF) || (mp_shrink(&(bignum))) == MP_OKAY) { \ + (objPtr)->internalRep.twoPtrValue.ptr1 = (bignum).dp; \ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \ - | ((bignum).alloc << 15) | ((bignum).used)); \ + | ((bignum).alloc << 15) | ((bignum).used)); \ } /* @@ -516,7 +515,7 @@ TclGetContLineTable(void) if (!tsdPtr->lineCLPtr) { tsdPtr->lineCLPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS); - Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines, NULL); + Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL); } return tsdPtr; } @@ -578,7 +577,7 @@ TclContinuationsEnter( clLocPtr->num = num; memcpy(&clLocPtr->loc, loc, num*sizeof(Tcl_Size)); - clLocPtr->loc[num] = CLL_END; /* Sentinel */ + clLocPtr->loc[num] = CLL_END; /* Sentinel */ Tcl_SetHashValue(hPtr, clLocPtr); return clLocPtr; @@ -638,7 +637,7 @@ TclContinuationsEnterDerived( */ (void)TclGetStringFromObj(objPtr, &length); - end = start + length; /* First char after the word */ + end = start + length; /* First char after the word */ /* * Then compute the table slice covering the range of the word. @@ -703,7 +702,8 @@ TclContinuationsCopy( Tcl_Obj *originObjPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr); + Tcl_HashEntry *hPtr = + Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr); if (hPtr) { ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_GetHashValue(hPtr); @@ -736,10 +736,11 @@ TclContinuationsGet( Tcl_Obj *objPtr) { ThreadSpecificData *tsdPtr = TclGetContLineTable(); - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); + Tcl_HashEntry *hPtr = + Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (!hPtr) { - return NULL; + return NULL; } return (ContLineLoc *)Tcl_GetHashValue(hPtr); } @@ -1033,9 +1034,9 @@ TclDbDumpActiveObjects( void TclDbInitNewObj( Tcl_Obj *objPtr, - const char *file, /* The name of the source file calling this + 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 + int line) /* Line number in the source file; used for * debugging. */ { objPtr->refCount = 0; @@ -1161,9 +1162,9 @@ Tcl_NewObj(void) Tcl_Obj * Tcl_DbNewObj( - const char *file, /* The name of the source file calling this + 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 + int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; @@ -1268,7 +1269,7 @@ TclAllocateFreeObjects(void) #ifdef TCL_MEM_DEBUG void TclFreeObj( - Tcl_Obj *objPtr) /* The object to be freed. */ + Tcl_Obj *objPtr) /* The object to be freed. */ { const Tcl_ObjType *typePtr = objPtr->typePtr; @@ -1378,10 +1379,10 @@ TclFreeObj( { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { - hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); + hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); @@ -1393,7 +1394,7 @@ TclFreeObj( void TclFreeObj( - Tcl_Obj *objPtr) /* The object to be freed. */ + Tcl_Obj *objPtr) /* The object to be freed. */ { /* * Invalidate the string rep first so we can use the bytes value for our @@ -1469,10 +1470,10 @@ TclFreeObj( { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_HashEntry *hPtr; + Tcl_HashEntry *hPtr; if (tsdPtr->lineCLPtr) { - hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); + hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr); if (hPtr) { Tcl_Free(Tcl_GetHashValue(hPtr)); Tcl_DeleteHashEntry(hPtr); @@ -1536,7 +1537,7 @@ TclObjBeingDeleted( *---------------------------------------------------------------------- */ -#define SetDuplicateObj(dupPtr, objPtr) \ +#define SetDuplicateObj(dupPtr, objPtr) \ { \ const Tcl_ObjType *typePtr = (objPtr)->typePtr; \ const char *bytes = (objPtr)->bytes; \ @@ -1603,7 +1604,7 @@ TclSetDuplicateObj( #undef Tcl_GetString char * Tcl_GetString( - Tcl_Obj *objPtr) /* Object whose string rep byte pointer should + Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be returned. */ { if (objPtr->bytes == NULL) { @@ -1661,9 +1662,9 @@ Tcl_GetString( #undef TclGetStringFromObj char * TclGetStringFromObj( - Tcl_Obj *objPtr, /* Object whose string rep byte pointer should + Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ - void *lengthPtr) /* If non-NULL, the location where the string + void *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { @@ -1706,7 +1707,7 @@ TclGetStringFromObj( #undef Tcl_GetStringFromObj char * Tcl_GetStringFromObj( - Tcl_Obj *objPtr, /* Object whose string rep byte pointer should + Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ Tcl_Size *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. @@ -1789,7 +1790,7 @@ Tcl_GetStringFromObj( char * Tcl_InitStringRep( - Tcl_Obj *objPtr, /* Object whose string rep is to be set */ + Tcl_Obj *objPtr, /* Object whose string rep is to be set */ const char *bytes, size_t numBytes) { @@ -1860,7 +1861,7 @@ Tcl_InitStringRep( void Tcl_InvalidateStringRep( - Tcl_Obj *objPtr) /* Object whose string rep byte pointer should + Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be freed. */ { TclInvalidateStringRep(objPtr); @@ -1880,7 +1881,7 @@ Tcl_InvalidateStringRep( int Tcl_HasStringRep( - Tcl_Obj *objPtr) /* Object to test */ + Tcl_Obj *objPtr) /* Object to test */ { return TclHasStringRep(objPtr); } @@ -1911,8 +1912,7 @@ void Tcl_StoreInternalRep( Tcl_Obj *objPtr, /* Object whose internal rep should be set. */ const Tcl_ObjType *typePtr, /* New type for the object */ - const Tcl_ObjInternalRep *irPtr) - /* New internalrep for the object */ + const Tcl_ObjInternalRep *irPtr) /* New internalrep for the object */ { /* Clear out any existing internalrep ( "shimmer" ) */ TclFreeInternalRep(objPtr); @@ -1973,7 +1973,7 @@ Tcl_FetchInternalRep( void Tcl_FreeInternalRep( - Tcl_Obj *objPtr) /* Object whose internal rep should be freed. */ + Tcl_Obj *objPtr) /* Object whose internal rep should be freed. */ { TclFreeInternalRep(objPtr); } @@ -2000,32 +2000,27 @@ Tcl_FreeInternalRep( #undef Tcl_GetBoolFromObj int Tcl_GetBoolFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get boolean. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get boolean. */ int flags, - char *charPtr) /* Place to store resulting boolean. */ + char *charPtr) /* Place to store resulting boolean. */ { int result; - if ((flags & TCL_NULL_OK) - && (objPtr == NULL || Tcl_GetString(objPtr)[0] == '\0')) { + if ((flags & TCL_NULL_OK) && (objPtr == NULL || Tcl_GetString(objPtr)[0] == '\0')) { result = -1; goto boolEnd; } else if (objPtr == NULL) { if (interp) { TclNewObj(objPtr); - TclParseNumber(interp, objPtr, - (flags & TCL_NULL_OK) - ? "boolean value or \"\"" - : "boolean value", - NULL, TCL_INDEX_NONE, NULL, 0); + TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK) + ? "boolean value or \"\"" : "boolean value", NULL, TCL_INDEX_NONE, NULL, 0); Tcl_DecrRefCount(objPtr); } return TCL_ERROR; } do { - if (TclHasInternalRep(objPtr, &tclIntType) - || TclHasInternalRep(objPtr, &tclBooleanType)) { + if (TclHasInternalRep(objPtr, &tclIntType) || TclHasInternalRep(objPtr, &tclBooleanType)) { result = (objPtr->internalRep.wideValue != 0); goto boolEnd; } @@ -2067,23 +2062,19 @@ Tcl_GetBoolFromObj( return TCL_OK; } } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK == - TclParseNumber(interp, objPtr, - (flags & TCL_NULL_OK) - ? "boolean value or \"\"" - : "boolean value", - NULL, -1, NULL, 0))); + TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK) + ? "boolean value or \"\"" : "boolean value", NULL,-1,NULL,0))); return TCL_ERROR; } #undef Tcl_GetBooleanFromObj int Tcl_GetBooleanFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get boolean. */ - int *intPtr) /* Place to store resulting boolean. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get boolean. */ + int *intPtr) /* Place to store resulting boolean. */ { - return Tcl_GetBoolFromObj(interp, objPtr, - (TCL_NULL_OK - 2) & (int) sizeof(int), (char *)(void *)intPtr); + return Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof(int), (char *)(void *)intPtr); } /* @@ -2109,7 +2100,7 @@ Tcl_GetBooleanFromObj( int TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { /* * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine @@ -2155,7 +2146,7 @@ TclSetBooleanFromAny( static int ParseBoolean( - Tcl_Obj *objPtr) /* The object to parse/convert. */ + Tcl_Obj *objPtr) /* The object to parse/convert. */ { int newBool; char lowerCase[6]; @@ -2297,7 +2288,7 @@ ParseBoolean( Tcl_Obj * Tcl_NewDoubleObj( - double dblValue) /* Double used to initialize the object. */ + double dblValue) /* Double used to initialize the object. */ { return Tcl_DbNewDoubleObj(dblValue, "unknown", 0); } @@ -2306,7 +2297,7 @@ Tcl_NewDoubleObj( Tcl_Obj * Tcl_NewDoubleObj( - double dblValue) /* Double used to initialize the object. */ + double dblValue) /* Double used to initialize the object. */ { Tcl_Obj *objPtr; @@ -2345,7 +2336,7 @@ Tcl_NewDoubleObj( Tcl_Obj * Tcl_DbNewDoubleObj( - double dblValue, /* Double used to initialize the object. */ + 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 @@ -2366,7 +2357,7 @@ Tcl_DbNewDoubleObj( Tcl_Obj * Tcl_DbNewDoubleObj( - double dblValue, /* Double used to initialize the object. */ + double dblValue, /* Double used to initialize the object. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { @@ -2394,8 +2385,8 @@ Tcl_DbNewDoubleObj( void Tcl_SetDoubleObj( - Tcl_Obj *objPtr, /* Object whose internal rep to init. */ - double dblValue) /* Double used to set the object's value. */ + 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"); @@ -2426,9 +2417,9 @@ Tcl_SetDoubleObj( 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. */ + 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 (TclHasInternalRep(objPtr, &tclDoubleType)) { @@ -2436,8 +2427,8 @@ Tcl_GetDoubleFromObj( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "floating point value is Not a Number", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN", - (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN", + (void *)NULL); } return TCL_ERROR; } @@ -2482,7 +2473,7 @@ Tcl_GetDoubleFromObj( static int SetDoubleFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1, NULL, 0); @@ -2510,7 +2501,7 @@ SetDoubleFromAny( static void UpdateStringOfDouble( - Tcl_Obj *objPtr) /* Double obj with string rep to update. */ + Tcl_Obj *objPtr) /* Double obj with string rep to update. */ { char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE); @@ -2551,9 +2542,9 @@ UpdateStringOfDouble( 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. */ + 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); @@ -2623,7 +2614,7 @@ SetIntFromAny( static void UpdateStringOfInt( - Tcl_Obj *objPtr) /* Int object whose string rep to update. */ + Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); @@ -2655,9 +2646,9 @@ UpdateStringOfInt( 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. */ + 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 @@ -2687,9 +2678,9 @@ Tcl_GetLongFromObj( #endif if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; @@ -2773,7 +2764,8 @@ Tcl_GetLongFromObj( Tcl_Obj * Tcl_NewWideIntObj( - Tcl_WideInt wideValue) /* Wide integer used to initialize the new + Tcl_WideInt wideValue) + /* Wide integer used to initialize the new * object. */ { return Tcl_DbNewWideIntObj(wideValue, "unknown", 0); @@ -2783,7 +2775,8 @@ Tcl_NewWideIntObj( Tcl_Obj * Tcl_NewWideIntObj( - Tcl_WideInt wideValue) /* Wide integer used to initialize the new + Tcl_WideInt wideValue) + /* Wide integer used to initialize the new * object. */ { Tcl_Obj *objPtr; @@ -2811,7 +2804,8 @@ Tcl_NewWideIntObj( Tcl_Obj * Tcl_NewWideUIntObj( - Tcl_WideUInt uwideValue) /* Wide integer used to initialize the new + Tcl_WideUInt uwideValue) + /* Wide integer used to initialize the new * object. */ { Tcl_Obj *objPtr; @@ -2856,7 +2850,8 @@ Tcl_NewWideUIntObj( Tcl_Obj * Tcl_DbNewWideIntObj( - Tcl_WideInt wideValue, /* Wide integer used to initialize the new + 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. */ @@ -2874,7 +2869,8 @@ Tcl_DbNewWideIntObj( Tcl_Obj * Tcl_DbNewWideIntObj( - Tcl_WideInt wideValue, /* Long integer used to initialize the new + Tcl_WideInt wideValue, + /* Long integer used to initialize the new * object. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) @@ -2903,8 +2899,9 @@ Tcl_DbNewWideIntObj( void Tcl_SetWideIntObj( - Tcl_Obj *objPtr, /* Object w. internal rep to init. */ - Tcl_WideInt wideValue) /* Wide integer used to initialize the + 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)) { @@ -2934,8 +2931,9 @@ Tcl_SetWideIntObj( void Tcl_SetWideUIntObj( - Tcl_Obj *objPtr, /* Object w. internal rep to init. */ - Tcl_WideUInt uwideValue) /* Wide integer used to initialize the + Tcl_Obj *objPtr, /* Object w. internal rep to init. */ + Tcl_WideUInt uwideValue) + /* Wide integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { @@ -2976,9 +2974,10 @@ Tcl_SetWideUIntObj( 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. */ + 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 (TclHasInternalRep(objPtr, &tclIntType)) { @@ -2987,9 +2986,9 @@ Tcl_GetWideIntFromObj( } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; @@ -3007,8 +3006,7 @@ Tcl_GetWideIntFromObj( unsigned char *bytes = (unsigned char *) &scratch; TclUnpackBignum(objPtr, big); - if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), - &numBytes) == MP_OKAY) { + if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes) == MP_OKAY) { while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } @@ -3061,9 +3059,10 @@ Tcl_GetWideIntFromObj( int Tcl_GetWideUIntFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* Object from which to get a wide int. */ - Tcl_WideUInt *wideUIntPtr) /* Place to store resulting long. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* Object from which to get a wide int. */ + Tcl_WideUInt *wideUIntPtr) + /* Place to store resulting long. */ { do { if (TclHasInternalRep(objPtr, &tclIntType)) { @@ -3099,8 +3098,7 @@ Tcl_GetWideUIntFromObj( if (big.sign == MP_NEG) { goto wideUIntOutOfRange; } - if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideUInt), - &numBytes) == MP_OKAY) { + if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideUInt), &numBytes) == MP_OKAY) { while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } @@ -3146,9 +3144,9 @@ Tcl_GetWideUIntFromObj( int TclGetWideBitsFromObj( - 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 wide integer. */ + 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 wide integer. */ { do { if (TclHasInternalRep(objPtr, &tclIntType)) { @@ -3157,9 +3155,9 @@ TclGetWideBitsFromObj( } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; @@ -3210,9 +3208,9 @@ TclGetWideBitsFromObj( */ int Tcl_GetSizeIntFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get a int. */ - Tcl_Size *sizePtr) /* Place to store resulting int. */ + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get a int. */ + Tcl_Size *sizePtr) /* Place to store resulting int. */ { if (sizeof(Tcl_Size) == sizeof(int)) { return TclGetIntFromObj(interp, objPtr, (int *)sizePtr); @@ -3481,9 +3479,9 @@ GetBignumFromObj( } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer but got \"%s\"", + TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; @@ -3522,7 +3520,7 @@ int Tcl_GetBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ - void *bignumValue) /* Returned bignum value. */ + void *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 1, (mp_int *)bignumValue); } @@ -3557,7 +3555,7 @@ int Tcl_TakeBignumFromObj( Tcl_Interp *interp, /* Tcl interpreter for error reporting */ Tcl_Obj *objPtr, /* Object to read */ - void *bignumValue) /* Returned bignum value. */ + void *bignumValue) /* Returned bignum value. */ { return GetBignumFromObj(interp, objPtr, 0, (mp_int *)bignumValue); } @@ -3659,17 +3657,17 @@ TclSetBignumInternalRep( * * Tcl_GetNumberFromObj -- * - * Extracts a number (of any possible numeric type) from an object. + * Extracts a number (of any possible numeric type) from an object. * * Results: - * Whether the extraction worked. The type is stored in the variable - * referred to by the typePtr argument, and a pointer to the - * representation is stored in the variable referred to by the - * clientDataPtr. + * Whether the extraction worked. The type is stored in the variable + * referred to by the typePtr argument, and a pointer to the + * representation is stored in the variable referred to by the + * clientDataPtr. * * Side effects: - * Can allocate thread-specific data for handling the copy-out space for - * bignums; this space is shared within a thread. + * Can allocate thread-specific data for handling the copy-out space for + * bignums; this space is shared within a thread. * *---------------------------------------------------------------------- */ @@ -3763,8 +3761,7 @@ Tcl_GetNumber( #undef Tcl_IncrRefCount void Tcl_IncrRefCount( - Tcl_Obj *objPtr) /* The object we are registering a reference - * to. */ + Tcl_Obj *objPtr) /* The object we are registering a reference to. */ { ++(objPtr)->refCount; } @@ -3785,8 +3782,7 @@ Tcl_IncrRefCount( #undef Tcl_DecrRefCount void Tcl_DecrRefCount( - Tcl_Obj *objPtr) /* The object we are releasing a reference - * to. */ + Tcl_Obj *objPtr) /* The object we are releasing a reference to. */ { if (objPtr->refCount-- <= 1) { TclFreeObj(objPtr); @@ -3808,8 +3804,7 @@ Tcl_DecrRefCount( */ void TclUndoRefCount( - Tcl_Obj *objPtr) /* The object we are releasing a reference - * to. */ + Tcl_Obj *objPtr) /* The object we are releasing a reference to. */ { if (objPtr->refCount > 0) { --objPtr->refCount; @@ -3832,7 +3827,7 @@ TclUndoRefCount( #undef Tcl_IsShared int Tcl_IsShared( - Tcl_Obj *objPtr) /* The object to test for being shared. */ + Tcl_Obj *objPtr) /* The object to test for being shared. */ { return ((objPtr)->refCount > 1); } @@ -3861,7 +3856,7 @@ Tcl_IsShared( #ifdef TCL_MEM_DEBUG void Tcl_DbIncrRefCount( - Tcl_Obj *objPtr, /* The object we are registering a reference + 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. */ @@ -3892,7 +3887,7 @@ Tcl_DbIncrRefCount( hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", - "incr ref count"); + "incr ref count"); } } # endif /* TCL_THREADS */ @@ -3901,7 +3896,7 @@ Tcl_DbIncrRefCount( #else /* !TCL_MEM_DEBUG */ void Tcl_DbIncrRefCount( - Tcl_Obj *objPtr, /* The object we are registering a reference + Tcl_Obj *objPtr, /* The object we are registering a reference * to. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) @@ -3934,7 +3929,7 @@ Tcl_DbIncrRefCount( #ifdef TCL_MEM_DEBUG void Tcl_DbDecrRefCount( - Tcl_Obj *objPtr, /* The object we are releasing a reference + 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. */ @@ -3965,7 +3960,7 @@ Tcl_DbDecrRefCount( hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", - "decr ref count"); + "decr ref count"); } } # endif /* TCL_THREADS */ @@ -3977,7 +3972,7 @@ Tcl_DbDecrRefCount( #else /* !TCL_MEM_DEBUG */ void Tcl_DbDecrRefCount( - Tcl_Obj *objPtr, /* The object we are releasing a reference + Tcl_Obj *objPtr, /* The object we are releasing a reference * to. */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) @@ -4011,7 +4006,7 @@ Tcl_DbDecrRefCount( int Tcl_DbIsShared( - Tcl_Obj *objPtr, /* The object to test for being shared. */ + Tcl_Obj *objPtr, /* The object to test for being shared. */ #ifdef TCL_MEM_DEBUG const char *file, /* The name of the source file calling this * function; used for debugging. */ @@ -4047,7 +4042,7 @@ Tcl_DbIsShared( hPtr = Tcl_FindHashEntry(tablePtr, objPtr); if (!hPtr) { Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread", - "check shared status"); + "check shared status"); } } # endif /* TCL_THREADS */ @@ -4088,7 +4083,8 @@ Tcl_DbIsShared( void Tcl_InitObjHashTable( - Tcl_HashTable *tablePtr) /* Pointer to table record, which is supplied + Tcl_HashTable *tablePtr) + /* Pointer to table record, which is supplied * by the caller. */ { Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS, @@ -4310,7 +4306,7 @@ 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. + 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 @@ -4339,21 +4335,21 @@ Tcl_GetCommandFromObj( resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; if (TclHasInternalRep(objPtr, &tclCmdNameType)) { - Command *cmdPtr = resPtr->cmdPtr; + Command *cmdPtr = resPtr->cmdPtr; - if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) - && (interp == cmdPtr->nsPtr->interp) - && !(cmdPtr->nsPtr->flags & NS_DYING)) { - Namespace *refNsPtr = (Namespace *) - TclGetCurrentNamespace(interp); + if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) + && (interp == cmdPtr->nsPtr->interp) + && !(cmdPtr->nsPtr->flags & NS_DYING)) { + Namespace *refNsPtr = (Namespace *) + TclGetCurrentNamespace(interp); - if ((resPtr->refNsPtr == NULL) + if ((resPtr->refNsPtr == NULL) || ((refNsPtr == resPtr->refNsPtr) - && (resPtr->refNsId == refNsPtr->nsId) - && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) { - return (Tcl_Command) cmdPtr; - } - } + && (resPtr->refNsId == refNsPtr->nsId) + && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) { + return (Tcl_Command) cmdPtr; + } + } } /* @@ -4363,7 +4359,7 @@ Tcl_GetCommandFromObj( /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */ if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) { - return NULL; + return NULL; } resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL); @@ -4446,7 +4442,7 @@ 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 + 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. */ @@ -4486,7 +4482,7 @@ TclSetCmdNameObj( static void FreeCmdNameInternalRep( - Tcl_Obj *objPtr) /* CmdName object with internal + Tcl_Obj *objPtr) /* CmdName object with internal * representation to free. */ { ResolvedCmdName *resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1; @@ -4534,7 +4530,7 @@ FreeCmdNameInternalRep( static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1; @@ -4568,7 +4564,7 @@ DupCmdNameInternalRep( static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { const char *name; Command *cmdPtr; @@ -4655,8 +4651,7 @@ Tcl_RepresentationCmd( * "1872361827361287" */ - descObj = Tcl_ObjPrintf( - "value is a %s with a refcount of %" TCL_SIZE_MODIFIER "d," + descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_SIZE_MODIFIER "d," " object pointer at %p", objv[1]->typePtr ? objv[1]->typePtr->name : "pure string", objv[1]->refCount, objv[1]); @@ -4673,9 +4668,9 @@ Tcl_RepresentationCmd( } if (objv[1]->bytes) { - Tcl_AppendToObj(descObj, ", string representation \"", -1); + Tcl_AppendToObj(descObj, ", string representation \"", -1); Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length, - 16, "..."); + 16, "..."); Tcl_AppendToObj(descObj, "\"", -1); } else { Tcl_AppendToObj(descObj, ", no string representation", -1); diff --git a/generic/tclParse.c b/generic/tclParse.c index 9c17e0c..e88de0b 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -205,7 +205,8 @@ Tcl_ParseCommand( * 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 + Tcl_Parse *parsePtr) + /* Structure to fill in with information about * the parsed command; any previous * information in the structure is ignored. */ { @@ -530,7 +531,7 @@ Tcl_ParseCommand( /* Parse the whitespace between words. */ - scanned = ParseWhiteSpace(src, numBytes, &parsePtr->incomplete, &type); + scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type); src += scanned; numBytes -= scanned; } @@ -1038,7 +1039,7 @@ ParseComment( static int ParseTokens( - const char *src, /* First character to parse. */ + const char *src, /* First character to parse. */ Tcl_Size numBytes, /* Max number of bytes to scan. */ int mask, /* Specifies when to stop parsing. The parse * stops at the first unquoted character whose @@ -1389,20 +1390,15 @@ Tcl_ParseVarName( tokenPtr->numComponents = 0; ch = *src; - while (numBytes && (braceCount > 0 || ch != '}')) { + while (numBytes && (braceCount>0 || ch != '}')) { switch (ch) { - case '{': - braceCount++; - break; - case '}': - braceCount--; - break; + case '{': braceCount++; break; + case '}': braceCount--; break; case '\\': /* if 2 or more left, consume 2, else consume * just the \ and let it run into the end */ if (numBytes > 1) { - src++; - numBytes--; + src++; numBytes--; } } numBytes--; @@ -1415,7 +1411,7 @@ Tcl_ParseVarName( "missing close-brace for variable name", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; - parsePtr->term = tokenPtr->start - 1; + parsePtr->term = tokenPtr->start-1; parsePtr->incomplete = 1; goto error; } @@ -1535,7 +1531,7 @@ Tcl_ParseVarName( const char * Tcl_ParseVar( Tcl_Interp *interp, /* Context for looking up variable. */ - const char *start, /* Start of variable substitution. First + 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 @@ -1623,7 +1619,8 @@ Tcl_ParseBraces( Tcl_Size numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ - Tcl_Parse *parsePtr, /* Structure to fill in with information about + 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 @@ -1823,7 +1820,8 @@ Tcl_ParseQuotedString( Tcl_Size numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ - Tcl_Parse *parsePtr, /* Structure to fill in with information about + 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 diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 1fac268..9a44863 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -40,11 +40,11 @@ static int MakeTildeRelativePath(Tcl_Interp *interp, */ static const Tcl_ObjType fsPathType = { - "path", /* name */ - FreeFsPathInternalRep, /* freeIntRepProc */ - DupFsPathInternalRep, /* dupIntRepProc */ - UpdateStringOfFsPath, /* updateStringProc */ - SetFsPathFromAny, /* setFromAnyProc */ + "path", /* name */ + FreeFsPathInternalRep, /* freeIntRepProc */ + DupFsPathInternalRep, /* dupIntRepProc */ + UpdateStringOfFsPath, /* updateStringProc */ + SetFsPathFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; @@ -90,7 +90,7 @@ typedef struct { */ #define PATHOBJ(pathPtr) ((FsPath *) (TclFetchInternalRep((pathPtr), &fsPathType)->twoPtrValue.ptr1)) -#define SETPATHOBJ(pathPtr, fsPathPtr) \ +#define SETPATHOBJ(pathPtr,fsPathPtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \ @@ -155,17 +155,17 @@ TclFSNormalizeAbsolutePath( */ dirSep += zipVolumeLen-1; /* Start parse after : */ } else if (tclPlatform == TCL_PLATFORM_WINDOWS) { - if ((dirSep[0] == '/' || dirSep[0] == '\\') - && (dirSep[1] == '/' || dirSep[1] == '\\') - && (dirSep[2] == '?') - && (dirSep[3] == '/' || dirSep[3] == '\\')) { + if ( (dirSep[0] == '/' || dirSep[0] == '\\') + && (dirSep[1] == '/' || dirSep[1] == '\\') + && (dirSep[2] == '?') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { /* NT extended path */ dirSep += 4; - if ((dirSep[0] == 'U' || dirSep[0] == 'u') - && (dirSep[1] == 'N' || dirSep[1] == 'n') - && (dirSep[2] == 'C' || dirSep[2] == 'c') - && (dirSep[3] == '/' || dirSep[3] == '\\')) { + if ( (dirSep[0] == 'U' || dirSep[0] == 'u') + && (dirSep[1] == 'N' || dirSep[1] == 'n') + && (dirSep[2] == 'C' || dirSep[2] == 'c') + && (dirSep[3] == '/' || dirSep[3] == '\\')) { /* NT extended UNC path */ dirSep += 4; } @@ -726,7 +726,7 @@ TclPathPart( splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); Tcl_IncrRefCount(splitPtr); - if (portion == TCL_PATH_TAIL) { + if (portion == TCL_PATH_TAIL) { /* * Return the last component, unless it is the only component, and * it is the root of an absolute path. @@ -1054,8 +1054,8 @@ TclJoinPath( } ptr = TclGetStringFromObj(res, &length); - /* - * A NULL value for fsPtr at this stage basically means we're trying + /* + * A NULL value for fsPtr at this stage basically means we're trying * to join a relative path onto something which is also relative (or * empty). There's nothing particularly wrong with that. */ @@ -2347,7 +2347,7 @@ DupFsPathInternalRep( static void UpdateStringOfFsPath( - Tcl_Obj *pathPtr) /* path obj with string rep to update. */ + Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); Tcl_Size cwdLen; @@ -2451,8 +2451,8 @@ TclNativePathInFilesystem( * * MakeTildeRelativePath -- * - * Returns a path relative to the home directory of a user. - * Note there is a difference between not specifying a user and + * Returns a path relative to the home directory of a user. + * Note there is a difference between not specifying a user and * explicitly specifying the current user. This mimics Tcl8's tilde * expansion. * @@ -2469,11 +2469,11 @@ TclNativePathInFilesystem( */ int MakeTildeRelativePath( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ - const char *user, /* User name. NULL -> current user */ - const char *subPath, /* Rest of path. May be NULL */ - Tcl_DString *dsPtr) /* Output. Is initialized by the function. Must - * be freed on success */ + Tcl_Interp *interp, /* May be NULL. Only used for error messages */ + const char *user, /* User name. NULL -> current user */ + const char *subPath, /* Rest of path. May be NULL */ + Tcl_DString *dsPtr) /* Output. Is initialized by the function. Must be + * freed on success */ { const char *dir; Tcl_DString dirString; @@ -2482,30 +2482,30 @@ MakeTildeRelativePath( Tcl_DStringInit(&dirString); if (user == NULL || user[0] == 0) { - /* No user name specified -> current user */ + /* No user name specified -> current user */ dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment variable to expand path", + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find HOME environment variable to expand path", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", - "HOMELESS", (void *)NULL); - } - return TCL_ERROR; - } + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", + "HOMELESS", (void *)NULL); + } + return TCL_ERROR; + } } else { - /* User name specified - ~user */ + /* User name specified - ~user */ dir = TclpGetUserHome(user, &dirString); if (dir == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", user)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", - (void *)NULL); - } - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "user \"%s\" doesn't exist", user)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", + (void *)NULL); + } + return TCL_ERROR; } } if (subPath) { @@ -2530,15 +2530,15 @@ MakeTildeRelativePath( * Wrapper around MakeTildeRelativePath. See that function. * * Results: - * Returns a Tcl_Obj containing the home directory of a user + * Returns a Tcl_Obj containing the home directory of a user * or NULL on failure with error message in interp if non-NULL. * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetHomeDirObj( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ - const char *user) /* User name. NULL -> current user */ + Tcl_Interp *interp, /* May be NULL. Only used for error messages */ + const char *user) /* User name. NULL -> current user */ { Tcl_DString dirString; @@ -2559,17 +2559,17 @@ TclGetHomeDirObj( * begin with a tilde, returns as is. * * Results: - * Returns a Tcl_Obj with resolved path. This may be a new Tcl_Obj + * Returns a Tcl_Obj with resolved path. This may be a new Tcl_Obj * with ref count 0 or that pathObj that was passed in without its * ref count modified. - * Returns NULL if the path begins with a ~ that cannot be resolved + * Returns NULL if the path begins with a ~ that cannot be resolved * and stores an error message in interp if non-NULL. * *---------------------------------------------------------------------- */ Tcl_Obj * TclResolveTildePath( - Tcl_Interp *interp, /* May be NULL. Only used for error messages */ + Tcl_Interp *interp, /* May be NULL. Only used for error messages */ Tcl_Obj *pathObj) { const char *path; @@ -2591,19 +2591,19 @@ TclResolveTildePath( split = FindSplitPos(path, '/'); if (split == 1) { - /* No user name specified -> current user */ + /* No user name specified -> current user */ if (MakeTildeRelativePath(interp, NULL, path[1] ? 2 + path : NULL, &resolvedPath) != TCL_OK) { return NULL; } } else { - /* User name specified - ~user */ - const char *expandedUser; - Tcl_DString userName; + /* User name specified - ~user */ + const char *expandedUser; + Tcl_DString userName; - Tcl_DStringInit(&userName); - Tcl_DStringAppend(&userName, path+1, split-1); - expandedUser = Tcl_DStringValue(&userName); + Tcl_DStringInit(&userName); + Tcl_DStringAppend(&userName, path+1, split-1); + expandedUser = Tcl_DStringValue(&userName); /* path[split] is / or \0 */ if (MakeTildeRelativePath(interp, expandedUser, @@ -2626,9 +2626,9 @@ TclResolveTildePath( * the paths with any ~-prefixed paths resolved. * * Empty strings and ~-prefixed paths that cannot be resolved are - * removed from the returned list. + * removed from the returned list. * - * The trailing components of the path are returned verbatim. No + * The trailing components of the path are returned verbatim. No * processing is done on them. Moreover, no assumptions should be * made about the separators in the returned path. They may be / * or native. Appropriate path manipulations functions should be @@ -2653,31 +2653,31 @@ TclResolveTildePathList( const char *path; if (pathsObj == NULL) { - return NULL; + return NULL; } if (Tcl_ListObjGetElements(NULL, pathsObj, &objc, &objv) != TCL_OK) { - return NULL; /* Not a list */ + return NULL; /* Not a list */ } /* * Figure out if any paths need resolving to avoid unnecessary allocations. */ for (i = 0; i < objc; ++i) { - path = Tcl_GetString(objv[i]); - if (path[0] == '~') { - break; /* At least one path needs resolution */ - } + path = Tcl_GetString(objv[i]); + if (path[0] == '~') { + break; /* At least one path needs resolution */ + } } if (i == objc) { - return pathsObj; /* No paths needed to be resolved */ + return pathsObj; /* No paths needed to be resolved */ } resolvedPaths = Tcl_NewListObj(objc, NULL); for (i = 0; i < objc; ++i) { Tcl_Obj *resolvedPath; - path = Tcl_GetString(objv[i]); + path = Tcl_GetString(objv[i]); if (path[0] == 0) { - continue; /* Skip empty strings */ + continue; /* Skip empty strings */ } resolvedPath = TclResolveTildePath(NULL, objv[i]); if (resolvedPath) { diff --git a/generic/tclPipe.c b/generic/tclPipe.c index cc535ae..854ecd5 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -1021,7 +1021,7 @@ Tcl_Channel Tcl_OpenCommandChannel( Tcl_Interp *interp, /* Interpreter for error reporting. Can NOT be * NULL. */ - Tcl_Size argc, /* How many arguments. */ + Tcl_Size argc, /* How many arguments. */ const char **argv, /* Array of arguments for command pipe. */ int flags) /* Or'ed combination of TCL_STDIN, TCL_STDOUT, * TCL_STDERR, and TCL_ENFORCE_MODE. */ diff --git a/generic/tclPkg.c b/generic/tclPkg.c index ffc038d..50884a1 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -96,36 +96,26 @@ static void AddRequirementsToResult(Tcl_Interp *interp, int reqc, static void AddRequirementsToDString(Tcl_DString *dstring, int reqc, Tcl_Obj *const reqv[]); static Package * FindPackage(Tcl_Interp *interp, const char *name); -static int PkgRequireCore(void *data[], Tcl_Interp *interp, - int result); -static int PkgRequireCoreFinal(void *data[], Tcl_Interp *interp, - int result); -static int PkgRequireCoreCleanup(void *data[], Tcl_Interp *interp, - int result); -static int PkgRequireCoreStep1(void *data[], Tcl_Interp *interp, - int result); -static int PkgRequireCoreStep2(void *data[], Tcl_Interp *interp, - int result); -static int TclNRPkgRequireProc(void *clientData, - Tcl_Interp *interp, int reqc, - Tcl_Obj *const reqv[]); -static int SelectPackage(void *data[], Tcl_Interp *interp, - int result); -static int SelectPackageFinal(void *data[], Tcl_Interp *interp, - int result); -static int TclNRPackageObjCmdCleanup(void *data[], - Tcl_Interp *interp, int result); +static int PkgRequireCore(void *data[], Tcl_Interp *interp, int result); +static int PkgRequireCoreFinal(void *data[], Tcl_Interp *interp, int result); +static int PkgRequireCoreCleanup(void *data[], Tcl_Interp *interp, int result); +static int PkgRequireCoreStep1(void *data[], Tcl_Interp *interp, int result); +static int PkgRequireCoreStep2(void *data[], Tcl_Interp *interp, int result); +static int TclNRPkgRequireProc(void *clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]); +static int SelectPackage(void *data[], Tcl_Interp *interp, int result); +static int SelectPackageFinal(void *data[], Tcl_Interp *interp, int result); +static int TclNRPackageObjCmdCleanup(void *data[], Tcl_Interp *interp, int result); /* * Helper macros. */ -#define DupBlock(var, str, len) \ - ((var) = (char *) Tcl_Alloc(len), memcpy((var), (str), (len))) -#define DupString(var, str) \ - do { \ - size_t local__len = strlen(str) + 1; \ - DupBlock((var), (str), local__len); \ +#define DupBlock(v,s,len) \ + ((v) = (char *)Tcl_Alloc(len), memcpy((v),(s),(len))) +#define DupString(v,s) \ + do { \ + size_t local__len = strlen(s) + 1; \ + DupBlock((v),(s),local__len); \ } while (0) /* @@ -1260,7 +1250,7 @@ TclNRPackageObjCmd( hPtr = Tcl_NextHashEntry(&search)) { pkgPtr = (Package *)Tcl_GetHashValue(hPtr); if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) { - Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj( (char *)Tcl_GetHashKey(tablePtr, hPtr), -1)); } } @@ -1375,7 +1365,7 @@ TclNRPackageObjCmd( TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, - TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL, NULL); + TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL,NULL); Tcl_NRAddCallback(interp, PkgRequireCore, (void *) argv3, INT2PTR(newobjc), newObjvPtr, NULL); @@ -1401,7 +1391,7 @@ TclNRPackageObjCmd( } TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, - TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL, NULL); + TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL,NULL); Tcl_NRAddCallback(interp, PkgRequireCore, (void *) argv2, INT2PTR(newobjc), newObjvPtr, NULL); diff --git a/generic/tclPosixStr.c b/generic/tclPosixStr.c index 7d7653c..52d5f09 100644 --- a/generic/tclPosixStr.c +++ b/generic/tclPosixStr.c @@ -524,7 +524,7 @@ Tcl_ErrnoId(void) const char * Tcl_ErrnoMsg( - int err) /* Error number (such as in errno variable). */ + int err) /* Error number (such as in errno variable). */ { switch (err) { #if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW)) @@ -1022,7 +1022,7 @@ Tcl_ErrnoMsg( const char * Tcl_SignalId( - int sig) /* Number of signal. */ + int sig) /* Number of signal. */ { switch (sig) { #ifdef SIGABRT @@ -1156,7 +1156,7 @@ Tcl_SignalId( const char * Tcl_SignalMsg( - int sig) /* Number of signal. */ + int sig) /* Number of signal. */ { switch (sig) { #ifdef SIGABRT diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c index 58bc82d..36a9537 100644 --- a/generic/tclPreserve.c +++ b/generic/tclPreserve.c @@ -21,7 +21,7 @@ */ typedef struct { - void *clientData; /* Address of preserved block. */ + void *clientData; /* Address of preserved block. */ size_t refCount; /* Number of Tcl_Preserve calls in effect for * block. */ int mustFree; /* Non-zero means Tcl_EventuallyFree was @@ -36,11 +36,10 @@ typedef struct { * These variables are protected by "preserveMutex". */ -static Reference *refArray = NULL; - /* First in array of references. */ +static Reference *refArray = NULL; /* First in array of references. */ static size_t spaceAvl = 0; /* Total number of structures available at * *firstRefPtr. */ -static size_t inUse = 0; /* Count of structures currently in use in +static size_t inUse = 0; /* Count of structures currently in use in * refArray. */ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */ @@ -118,7 +117,7 @@ TclFinalizePreserve(void) void Tcl_Preserve( - void *clientData) /* Pointer to malloc'ed block of memory. */ + void *clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; size_t i; @@ -181,7 +180,7 @@ Tcl_Preserve( void Tcl_Release( - void *clientData) /* Pointer to malloc'ed block of memory. */ + void *clientData) /* Pointer to malloc'ed block of memory. */ { Reference *refPtr; size_t i; @@ -260,7 +259,7 @@ Tcl_Release( void Tcl_EventuallyFree( - void *clientData, /* Pointer to malloc'ed block of memory. */ + void *clientData, /* Pointer to malloc'ed block of memory. */ Tcl_FreeProc *freeProc) /* Function to actually do free. */ { Reference *refPtr; diff --git a/generic/tclProc.c b/generic/tclProc.c index 0dfdec8..2f87048 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -902,6 +902,7 @@ TclNRUplevelObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; @@ -910,11 +911,11 @@ TclNRUplevelObjCmd( Tcl_Obj *objPtr; if (objc < 2) { - /* to do: - * simplify things by interpreting the argument as a command when there - * is only one argument. This requires a TIP since currently a single - * argument is interpreted as a level indicator if possible. - */ + /* to do + * simplify things by interpreting the argument as a command when there + * is only one argument. This requires a TIP since currently a single + * argument is interpreted as a level indicator if possible. + */ uplevelSyntax: Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?"); return TCL_ERROR; @@ -1745,8 +1746,7 @@ TclNRInterpProcCore( } if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) { Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr); - const char *a[6]; - Tcl_Size i[2]; + const char *a[6]; Tcl_Size i[2]; TclDTraceInfo(info, a, i); TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); @@ -2108,7 +2108,7 @@ MakeProcError( void TclProcDeleteProc( - void *clientData) /* Procedure to be deleted. */ + void *clientData) /* Procedure to be deleted. */ { Proc *procPtr = (Proc *)clientData; diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 43b8cb4..a5607d9 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -40,7 +40,7 @@ static Tcl_HashTable infoTablePerResolvedPid; static int infoTablesInitialized = 0; /* 0 means not yet initialized. */ TCL_DECLARE_MUTEX(infoTablesMutex) -/* + /* * Prototypes for functions defined later in this file: */ diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index caf6461..04f060b 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -103,11 +103,11 @@ static int SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); */ const Tcl_ObjType tclRegexpType = { - "regexp", /* name */ - FreeRegexpInternalRep, /* freeIntRepProc */ - DupRegexpInternalRep, /* dupIntRepProc */ - NULL, /* updateStringProc */ - SetRegexpFromAny, /* setFromAnyProc */ + "regexp", /* name */ + FreeRegexpInternalRep, /* freeIntRepProc */ + DupRegexpInternalRep, /* dupIntRepProc */ + NULL, /* updateStringProc */ + SetRegexpFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; diff --git a/generic/tclResult.c b/generic/tclResult.c index e9b2c1f..7151fc4 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -441,7 +441,7 @@ Tcl_ResetResult( static void ResetObjResult( - Interp *iPtr) /* Points to the interpreter whose result + Interp *iPtr) /* Points to the interpreter whose result * object should be reset. */ { Tcl_Obj *objResultPtr = iPtr->objResultPtr; @@ -551,7 +551,7 @@ Tcl_SetObjErrorCode( * * Tcl_GetErrorLine -- * - * Returns the line number associated with the current error. + * Returns the line number associated with the current error. * *---------------------------------------------------------------------- */ @@ -568,7 +568,7 @@ Tcl_GetErrorLine( * * Tcl_SetErrorLine -- * - * Sets the line number associated with the current error. + * Sets the line number associated with the current error. * *---------------------------------------------------------------------- */ @@ -716,7 +716,7 @@ TclProcessReturn( iPtr->errorInfo = NULL; } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { Tcl_Size length; @@ -728,41 +728,41 @@ TclProcessReturn( } } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { - Tcl_Size len, valueObjc; - Tcl_Obj **valueObjv; - - if (Tcl_IsShared(iPtr->errorStack)) { - Tcl_Obj *newObj; - - newObj = Tcl_DuplicateObj(iPtr->errorStack); - Tcl_DecrRefCount(iPtr->errorStack); - Tcl_IncrRefCount(newObj); - iPtr->errorStack = newObj; - } - - /* - * List extraction done after duplication to avoid moving the rug - * if someone does [return -errorstack [info errorstack]] - */ - - if (TclListObjGetElements(interp, valuePtr, &valueObjc, - &valueObjv) == TCL_ERROR) { - return TCL_ERROR; - } - iPtr->resetErrorStack = 0; - TclListObjLength(interp, iPtr->errorStack, &len); - - /* - * Reset while keeping the list internalrep as much as possible. - */ - - Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc, - valueObjv); + Tcl_Size len, valueObjc; + Tcl_Obj **valueObjv; + + if (Tcl_IsShared(iPtr->errorStack)) { + Tcl_Obj *newObj; + + newObj = Tcl_DuplicateObj(iPtr->errorStack); + Tcl_DecrRefCount(iPtr->errorStack); + Tcl_IncrRefCount(newObj); + iPtr->errorStack = newObj; + } + + /* + * List extraction done after duplication to avoid moving the rug + * if someone does [return -errorstack [info errorstack]] + */ + + if (TclListObjGetElements(interp, valuePtr, &valueObjc, + &valueObjv) == TCL_ERROR) { + return TCL_ERROR; + } + iPtr->resetErrorStack = 0; + TclListObjLength(interp, iPtr->errorStack, &len); + + /* + * Reset while keeping the list internalrep as much as possible. + */ + + Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc, + valueObjv); } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { Tcl_SetObjErrorCode(interp, valuePtr); } else { @@ -770,7 +770,7 @@ TclProcessReturn( } Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE], - &valuePtr); + &valuePtr); if (valuePtr != NULL) { TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine); } @@ -843,8 +843,8 @@ TclMergeReturnOptions( */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad %s value: expected dictionary but got \"%s\"", - compare, TclGetString(objv[1]))); + "bad %s value: expected dictionary but got \"%s\"", + compare, TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", (void *)NULL); goto error; @@ -874,7 +874,7 @@ TclMergeReturnOptions( Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr); if (valuePtr != NULL) { if (TclGetCompletionCodeFromObj(interp, valuePtr, - &code) == TCL_ERROR) { + &code) == TCL_ERROR) { goto error; } Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]); @@ -893,8 +893,8 @@ TclMergeReturnOptions( */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -level value: expected non-negative integer but got" - " \"%s\"", TclGetString(valuePtr))); + "bad -level value: expected non-negative integer but got" + " \"%s\"", TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", (void *)NULL); goto error; } @@ -915,8 +915,8 @@ TclMergeReturnOptions( */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -errorcode value: expected a list but got \"%s\"", - TclGetString(valuePtr))); + "bad -errorcode value: expected a list but got \"%s\"", + TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE", (void *)NULL); goto error; @@ -937,24 +937,24 @@ TclMergeReturnOptions( */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -errorstack value: expected a list but got \"%s\"", - TclGetString(valuePtr))); + "bad -errorstack value: expected a list but got \"%s\"", + TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK", - (void *)NULL); + (void *)NULL); goto error; } - if (length % 2) { - /* - * Errorstack must always be an even-sized list - */ + if (length % 2) { + /* + * Errorstack must always be an even-sized list + */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "forbidden odd-sized list for -errorstack: \"%s\"", + "forbidden odd-sized list for -errorstack: \"%s\"", TclGetString(valuePtr))); Tcl_SetErrorCode(interp, "TCL", "RESULT", - "ODDSIZEDLIST_ERRORSTACK", (void *)NULL); + "ODDSIZEDLIST_ERRORSTACK", (void *)NULL); goto error; - } + } } /* @@ -1034,7 +1034,7 @@ Tcl_GetReturnOptions( if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, ""); - Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack); + Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack); } if (iPtr->errorCode) { Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode); @@ -1105,7 +1105,7 @@ Tcl_SetReturnOptions( if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv) || (objc % 2)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected dict but got \"%s\"", TclGetString(options))); + "expected dict but got \"%s\"", TclGetString(options))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", (void *)NULL); code = TCL_ERROR; } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv, diff --git a/generic/tclScan.c b/generic/tclScan.c index ae23c3d..cccdd7a 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -17,13 +17,13 @@ * Flag values used by Tcl_ScanObjCmd. */ -#define SCAN_NOSKIP 0x1 /* Don't skip blanks. */ -#define SCAN_SUPPRESS 0x2 /* Suppress assignment. */ -#define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */ -#define SCAN_WIDTH 0x8 /* A width value was supplied. */ +#define SCAN_NOSKIP 0x1 /* Don't skip blanks. */ +#define SCAN_SUPPRESS 0x2 /* Suppress assignment. */ +#define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */ +#define SCAN_WIDTH 0x8 /* A width value was supplied. */ -#define SCAN_LONGER 0x400 /* Asked for a wide value. */ -#define SCAN_BIG 0x800 /* Asked for a bignum value. */ +#define SCAN_LONGER 0x400 /* Asked for a wide value. */ +#define SCAN_BIG 0x800 /* Asked for a bignum value. */ /* * The following structure contains the information associated with a @@ -360,10 +360,12 @@ ValidateFormat( format - 1, (char **)&format, 10); /* INTL: "C" locale. */ /* Note >=, not >, to leave room for a nul */ if (ull >= TCL_SIZE_MAX) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "specified field width %" TCL_LL_MODIFIER - "u exceeds limit %" TCL_SIZE_MODIFIER "d.", - ull, (Tcl_Size)TCL_SIZE_MAX-1)); + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("specified field width %" TCL_LL_MODIFIER + "u exceeds limit %" TCL_SIZE_MODIFIER "d.", + ull, + (Tcl_Size)TCL_SIZE_MAX-1)); Tcl_SetErrorCode( interp, "TCL", "FORMAT", "WIDTHLIMIT", (void *)NULL); goto error; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index da2343e..1b78184 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -71,9 +71,9 @@ typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__))); # include # define TCL_IEEE_DOUBLE_ROUNDING_DECL # define TCL_IEEE_DOUBLE_ROUNDING \ - ieee_flags("set", "precision", "double", NULL) + ieee_flags("set","precision","double",NULL) # define TCL_DEFAULT_DOUBLE_ROUNDING \ - ieee_flags("clear", "precision", NULL, NULL) + ieee_flags("clear","precision",NULL,NULL) # endif #endif @@ -1696,7 +1696,7 @@ MakeLowPrecisionDouble( * ulp, so we need to change rounding mode to 53-bits. We also make * 'retval' volatile, so that it doesn't get promoted to a register. */ - volatile double retval; /* Value of the number. */ + volatile double retval; /* Value of the number. */ /* * Test for zero significand, which requires explicit construction @@ -2262,28 +2262,22 @@ NormalizeRightward( Tcl_WideUInt w = *wPtr; if (!(w & (Tcl_WideUInt) 0xFFFFFFFF)) { - w >>= 32; - rv += 32; + w >>= 32; rv += 32; } if (!(w & (Tcl_WideUInt) 0xFFFF)) { - w >>= 16; - rv += 16; + w >>= 16; rv += 16; } if (!(w & (Tcl_WideUInt) 0xFF)) { - w >>= 8; - rv += 8; + w >>= 8; rv += 8; } if (!(w & (Tcl_WideUInt) 0xF)) { - w >>= 4; - rv += 4; + w >>= 4; rv += 4; } if (!(w & 0x3)) { - w >>= 2; - rv += 2; + w >>= 2; rv += 2; } if (!(w & 0x1)) { - w >>= 1; - ++rv; + w >>= 1; ++rv; } *wPtr = w; return rv; @@ -2311,31 +2305,24 @@ RequiredPrecision( unsigned long wi; if (w & ((Tcl_WideUInt) 0xFFFFFFFF << 32)) { - wi = (unsigned long) (w >> 32); - rv = 32; + wi = (unsigned long) (w >> 32); rv = 32; } else { - wi = (unsigned long) w; - rv = 0; + wi = (unsigned long) w; rv = 0; } if (wi & 0xFFFF0000) { - wi >>= 16; - rv += 16; + wi >>= 16; rv += 16; } if (wi & 0xFF00) { - wi >>= 8; - rv += 8; + wi >>= 8; rv += 8; } if (wi & 0xF0) { - wi >>= 4; - rv += 4; + wi >>= 4; rv += 4; } if (wi & 0xC) { - wi >>= 2; - rv += 2; + wi >>= 2; rv += 2; } if (wi & 0x2) { - wi >>= 1; - ++rv; + wi >>= 1; ++rv; } if (wi & 0x1) { ++rv; @@ -2665,7 +2652,7 @@ ComputeScale( static inline void SetPrecisionLimits( - int flags, /* Type of conversion: TCL_DD_SHORTEST, + int flags, /* Type of conversion: TCL_DD_SHORTEST, * TCL_DD_E_FMT, TCL_DD_F_FMT. */ int k, /* Floor(log10(number to convert)) */ int *ndigitsPtr, /* IN/OUT: Number of digits requested (will be @@ -3161,9 +3148,7 @@ ShorteningInt64Conversion( if (b < S) { b = 10 * b; - ++m2plus; - ++m2minus; - ++m5; + ++m2plus; ++m2minus; ++m5; ilim = ilim1; --k; } @@ -3541,9 +3526,7 @@ ShorteningBignumConversionPowD( if ((err == MP_OKAY) && (b.used <= sd)) { err = mp_mul_d(&b, 10, &b); - ++m2plus; - ++m2minus; - ++m5; + ++m2plus; ++m2minus; ++m5; ilim = ilim1; --k; } @@ -3583,8 +3566,7 @@ ShorteningBignumConversionPowD( if (b.used > sd+1 || digit >= 10) { Tcl_Panic("wrong digit!"); } - --b.used; - mp_clamp(&b); + --b.used; mp_clamp(&b); } /* @@ -4560,11 +4542,9 @@ TclDoubleDigits( */ if (b2 >= s2 && s2 > 0) { - b2 -= s2; - s2 = 0; + b2 -= s2; s2 = 0; } else if (s2 >= b2 && b2 > 0) { - s2 -= b2; - b2 = 0; + s2 -= b2; b2 = 0; } if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] < 64) { @@ -4858,7 +4838,7 @@ Tcl_InitBignumFromDouble( double TclBignumToDouble( - const void *big) /* Integer to convert. */ + const void *big) /* Integer to convert. */ { mp_int b; int bits, shift, i, lsb; @@ -4979,7 +4959,7 @@ TclBignumToDouble( double TclCeil( - const void *big) /* Integer to convert. */ + const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; @@ -5045,7 +5025,7 @@ TclCeil( double TclFloor( - const void *big) /* Integer to convert. */ + const void *big) /* Integer to convert. */ { double r = 0.0; mp_int b; diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 1efaa67..05c578e 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1,9 +1,9 @@ /* * tclStringObj.c -- * - * This file contains functions that implement string operations on Tcl - * objects. Some string operations work with UTF-8 encoding forms. - * Functions that require knowledge of the width of each character, + * This file contains functions that implement string operations on Tcl + * objects. Some string operations work with UTF-8 encoding forms. + * Functions that require knowledge of the width of each character, * such as indexing, operate on fixed width encoding forms such as UTF-32. * * Conceptually, a string is a sequence of Unicode code points. Internally @@ -15,10 +15,10 @@ * numChars, but we don't store the fixed form encoding (unless * Tcl_GetUnicode is explicitly called). * - * The String object type stores one or both formats. The default - * behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is - * stored in the internal rep for future access (without an additional - * O(n) cost). + * The String object type stores one or both formats. The default + * behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is + * stored in the internal rep for future access (without an additional + * O(n) cost). * * To allow many appends to be done to an object without constantly * reallocating space, we allocate double the space and use the @@ -124,8 +124,8 @@ const Tcl_ObjType tclStringType = { static void GrowStringBuffer( Tcl_Obj *objPtr, - Tcl_Size needed, /* Not including terminating nul */ - int flag) /* If 0, try to overallocate */ + Tcl_Size needed, /* Not including terminating nul */ + int flag) /* If 0, try to overallocate */ { /* * Preconditions: @@ -718,8 +718,8 @@ Tcl_GetUnicodeFromObj( Tcl_Obj * Tcl_GetRange( Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ - Tcl_Size first, /* First index of the range. */ - Tcl_Size last) /* Last index of the range. */ + Tcl_Size first, /* First index of the range. */ + Tcl_Size last) /* Last index of the range. */ { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ String *stringPtr; @@ -2557,8 +2557,8 @@ Tcl_AppendFormatToObj( } default: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad field specifier \"%c\"", ch)); + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("bad field specifier \"%c\"", ch)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", (char *)NULL); } goto error; @@ -2760,7 +2760,7 @@ AppendPrintfToObjVA( } Tcl_ListObjAppendElement(NULL, list, - Tcl_NewStringObj(bytes, (end - bytes))); + Tcl_NewStringObj(bytes , (end - bytes))); break; } @@ -2805,11 +2805,11 @@ AppendPrintfToObjVA( case 'g': case 'G': if (size > 0) { - Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( - (double) va_arg(argList, long double))); + Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( + (double)va_arg(argList, long double))); } else { - Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( - va_arg(argList, double))); + Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( + va_arg(argList, double))); } seekingConversion = 0; break; @@ -3038,10 +3038,11 @@ TclStringRepeat( /* maxCount includes space for null */ if (count > (maxCount-1)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%" TCL_SIZE_MODIFIER - "d bytes) exceeded", - TCL_SIZE_MAX)); + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("max size for a Tcl value (%" TCL_SIZE_MODIFIER + "d bytes) exceeded", + TCL_SIZE_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); } return NULL; @@ -3268,8 +3269,7 @@ TclStringCat( } while (--oc); } else { /* Result will be concat of string reps. Pre-size it. */ - ov = objv; - oc = objc; + ov = objv; oc = objc; do { Tcl_Obj *pendingPtr = NULL; @@ -3353,8 +3353,7 @@ TclStringCat( return objv[first]; } - objv += first; - objc = (last - first + 1); + objv += first; objc = (last - first + 1); inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv); if (binary) { @@ -3369,8 +3368,7 @@ TclStringCat( if (inPlace) { Tcl_Size start = 0; - objResultPtr = *objv++; - objc--; + objResultPtr = *objv++; objc--; (void)Tcl_GetBytesFromObj(NULL, objResultPtr, &start); dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; } else { @@ -3400,8 +3398,7 @@ TclStringCat( if (inPlace) { Tcl_Size start; - objResultPtr = *objv++; - objc--; + objResultPtr = *objv++; objc--; /* Ugly interface! Force resize of the unicode array. */ (void)Tcl_GetUnicodeFromObj(objResultPtr, &start); @@ -3452,8 +3449,7 @@ TclStringCat( if (inPlace) { Tcl_Size start; - objResultPtr = *objv++; - objc--; + objResultPtr = *objv++; objc--; (void)TclGetStringFromObj(objResultPtr, &start); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { @@ -3525,9 +3521,9 @@ TclStringCat( static int UniCharNcasememcmp( - const void *ucsPtr, /* Unicode string to compare to uct. */ - const void *uctPtr, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of Unichars to compare. */ + const void *ucsPtr, /* Unicode string to compare to uct. */ + const void *uctPtr, /* Unicode string ucs is compared to. */ + size_t numChars) /* Number of Unichars to compare. */ { const Tcl_UniChar *ucs = (const Tcl_UniChar *)ucsPtr; const Tcl_UniChar *uct = (const Tcl_UniChar *)uctPtr; @@ -3548,7 +3544,7 @@ static int UtfNmemcmp( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; const char *cs = (const char *)csPtr; @@ -3580,7 +3576,7 @@ static int UtfNcasememcmp( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; const char *cs = (const char *)csPtr; @@ -3607,9 +3603,9 @@ UtfNcasememcmp( static int UniCharNmemcmp( - const void *ucsPtr, /* Unicode string to compare to uct. */ - const void *uctPtr, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of unichars to compare. */ + const void *ucsPtr, /* Unicode string to compare to uct. */ + const void *uctPtr, /* Unicode string ucs is compared to. */ + size_t numChars) /* Number of unichars to compare. */ { const Tcl_UniChar *ucs = (const Tcl_UniChar *)ucsPtr; const Tcl_UniChar *uct = (const Tcl_UniChar *)uctPtr; @@ -3641,7 +3637,7 @@ TclStringCmp( int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ Tcl_Size reqlength) /* requested length in characters; - * TCL_INDEX_NONE to compare whole strings */ + * TCL_INDEX_NONE to compare whole strings */ { const char *s1, *s2; int empty, match; @@ -3687,8 +3683,9 @@ TclStringCmp( && (value1Ptr->bytes != NULL) && (s2len == value2Ptr->length) && (value2Ptr->bytes != NULL)) { - /* each byte represents one character so s1l3n, s2l3n, and - * reqlength are in both bytes and characters */ + /* each byte represents one character so s1l3n, s2l3n, and + * reqlength are in both bytes and characters + */ s1 = value1Ptr->bytes; s2 = value2Ptr->bytes; memCmpFn = memcmp; diff --git a/generic/tclStubCall.c b/generic/tclStubCall.c index 34bcb2f..29af44c 100644 --- a/generic/tclStubCall.c +++ b/generic/tclStubCall.c @@ -9,8 +9,8 @@ #ifndef _WIN32 # include #else -# define dlopen(a, b) (void *)LoadLibraryW(JOIN(L, a)) -# define dlsym(a, b) (void *)GetProcAddress((HMODULE)(a), b) +# define dlopen(a,b) (void *)LoadLibraryW(JOIN(L,a)) +# define dlsym(a,b) (void *)GetProcAddress((HMODULE)(a),b) # define dlerror() "" #endif @@ -52,15 +52,14 @@ static const char PROCNAME[][24] = { }; MODULE_SCOPE const void *nullVersionProc(void) { - return NULL; + return NULL; } static const char CANNOTCALL[] = "Cannot call %s from stubbed extension\n"; static const char CANNOTFIND[] = "Cannot find %s: %s\n"; MODULE_SCOPE void * -TclStubCall( - void *arg) +TclStubCall(void *arg) { static void *stubFn[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}; size_t index = PTR2UINT(arg); diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index f8b8d68..90501ff 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -96,13 +96,8 @@ # define TclParseArgsObjv 0 # define TclGetAliasObj 0 #else /* !defined(TCL_NO_DEPRECATED) */ -int -TclListObjGetElements( - Tcl_Interp *interp, - Tcl_Obj *listPtr, - void *objcPtr, - Tcl_Obj ***objvPtr) -{ +int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, + void *objcPtr, Tcl_Obj ***objvPtr) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr); if (objcPtr) { @@ -116,12 +111,8 @@ TclListObjGetElements( } return result; } -int -TclListObjLength( - Tcl_Interp *interp, - Tcl_Obj *listPtr, - void *lengthPtr) -{ +int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, + void *lengthPtr) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjLength(interp, listPtr, &n); if (lengthPtr) { @@ -135,12 +126,8 @@ TclListObjLength( } return result; } -int -TclDictObjSize( - Tcl_Interp *interp, - Tcl_Obj *dictPtr, - void *sizePtr) -{ +int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, + void *sizePtr) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_DictObjSize(interp, dictPtr, &n); if (sizePtr) { @@ -154,13 +141,8 @@ TclDictObjSize( } return result; } -int -TclSplitList( - Tcl_Interp *interp, - const char *listStr, - void *argcPtr, - const char ***argvPtr) -{ +int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr, + const char ***argvPtr) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_SplitList(interp, listStr, &n, argvPtr); if (argcPtr) { @@ -175,12 +157,7 @@ TclSplitList( } return result; } -void -TclSplitPath( - const char *path, - void *argcPtr, - const char ***argvPtr) -{ +void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) { Tcl_Size n = TCL_INDEX_NONE; Tcl_SplitPath(path, &n, argvPtr); if (argcPtr) { @@ -192,11 +169,7 @@ TclSplitPath( *(int *)argcPtr = (int)n; } } -Tcl_Obj * -TclFSSplitPath( - Tcl_Obj *pathPtr, - void *lenPtr) -{ +Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) { Tcl_Size n = TCL_INDEX_NONE; Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n); if (lenPtr) { @@ -208,28 +181,17 @@ TclFSSplitPath( } return result; } -int -TclParseArgsObjv( - Tcl_Interp *interp, - const Tcl_ArgvInfo *argTable, - void *objcPtr, - Tcl_Obj *const *objv, - Tcl_Obj ***remObjv) -{ +int TclParseArgsObjv(Tcl_Interp *interp, + const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv, + Tcl_Obj ***remObjv) { Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ; int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv); *(int *)objcPtr = (int)n; return result; } -int -TclGetAliasObj( - Tcl_Interp *interp, - const char *childCmd, - Tcl_Interp **targetInterpPtr, - const char **targetCmdPtr, - int *objcPtr, - Tcl_Obj ***objv) -{ +int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd, + Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, + int *objcPtr, Tcl_Obj ***objv) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, &n, objv); if (objcPtr) { @@ -344,8 +306,7 @@ doNothing(void) #define TclWinNoBackslash winNoBackslash static char * -TclWinNoBackslash( - char *path) +TclWinNoBackslash(char *path) { char *p; @@ -357,8 +318,7 @@ TclWinNoBackslash( return path; } -void * -TclWinGetTclInstance(void) +void *TclWinGetTclInstance(void) { void *hInstance = NULL; GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, @@ -367,8 +327,7 @@ TclWinGetTclInstance(void) } Tcl_Size -TclpGetPid( - Tcl_Pid pid) +TclpGetPid(Tcl_Pid pid) { return (Tcl_Size)PTR2INT(pid); } @@ -379,14 +338,8 @@ TclpGetPid( * signature. Tcl 9 must find a better solution, but that cannot be done * without introducing a binary incompatibility. */ -#define Tcl_GetLongFromObj \ - (int(*)(Tcl_Interp*,Tcl_Obj*,long*))(void *)Tcl_GetIntFromObj -static int -exprInt( - Tcl_Interp *interp, - const char *expr, - int *ptr) -{ +#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))(void *)Tcl_GetIntFromObj +static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){ long longValue; int result = Tcl_ExprLong(interp, expr, &longValue); if (result == TCL_OK) { @@ -401,14 +354,8 @@ exprInt( } return result; } -#define Tcl_ExprLong \ - (int(*)(Tcl_Interp*,const char*,long*))(void *)exprInt -static int -exprIntObj( - Tcl_Interp *interp, - Tcl_Obj*expr, - int *ptr) -{ +#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))(void *)exprInt +static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ long longValue; int result = Tcl_ExprLongObj(interp, expr, &longValue); if (result == TCL_OK) { @@ -455,15 +402,10 @@ MODULE_SCOPE const TclTomMathStubs tclTomMathStubs; #ifdef TCL_WITH_EXTERNAL_TOMMATH /* If Tcl is linked with an external libtommath 1.2.x, then mp_expt_n doesn't * exist (since that was introduced in libtommath 1.3.0. Provide it here.) */ -mp_err MP_WUR -TclBN_mp_expt_n( - const mp_int *a, - int b, - mp_int *c) -{ - if ((unsigned)b > MP_MIN(MP_DIGIT_MAX, INT_MAX)) { - return MP_VAL; - } +mp_err MP_WUR TclBN_mp_expt_n(const mp_int *a, int b, mp_int *c) { + if ((unsigned)b > MP_MIN(MP_DIGIT_MAX, INT_MAX)) { + return MP_VAL; + } return mp_expt_u32(a, (uint32_t)b, c);; } #endif /* TCL_WITH_EXTERNAL_TOMMATH */ diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index d589199..55001cf 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -92,8 +92,7 @@ Tcl_InitStubs( p = version; while (*p && (*p == *q)) { - p++; - q++; + p++; q++; } if (*p || ISDIGIT(*q)) { /* Construct error message */ diff --git a/generic/tclThread.c b/generic/tclThread.c index f9266ce..c107780 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -23,9 +23,9 @@ */ typedef struct { - int num; /* Number of objects remembered */ - int max; /* Max size of the array */ - void **list; /* List of pointers */ + int num; /* Number of objects remembered */ + int max; /* Max size of the array */ + void **list; /* List of pointers */ } SyncObjRecord; static SyncObjRecord keyRecord = {0, 0, NULL}; diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index e7eb37e..011d61b 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -92,7 +92,7 @@ typedef struct { size_t numRemoves; /* Number of removes from bucket */ size_t numInserts; /* Number of inserts into bucket */ size_t numLocks; /* Number of locks acquired */ - size_t totalAssigned; /* Total space assigned to bucket */ + size_t totalAssigned; /* Total space assigned to bucket */ } Bucket; /* @@ -120,7 +120,7 @@ typedef struct Cache { static struct { size_t blockSize; /* Bucket blocksize. */ size_t maxBlocks; /* Max blocks before move to share. */ - size_t numMove; /* Num blocks to move to share. */ + size_t numMove; /* Num blocks to move to share. */ Tcl_Mutex *lockPtr; /* Share bucket lock. */ } bucketInfo[NBUCKETS]; @@ -214,7 +214,7 @@ GetCache(void) if (cachePtr == NULL) { Tcl_Panic("alloc: could not allocate new cache"); } - memset(cachePtr, 0, sizeof(Cache)); + memset(cachePtr, 0, sizeof(Cache)); Tcl_MutexLock(listLockPtr); cachePtr->nextPtr = firstCachePtr; firstCachePtr = cachePtr; @@ -1035,7 +1035,7 @@ GetBlocks( * TclInitThreadAlloc -- * * Initializes the allocator cache-maintenance structures. - * It is done early and protected during the Tcl_InitSubsystems(). + * It is done early and protected during the Tcl_InitSubsystems(). * * Results: * None. diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c index 3d79407..22dd0c3 100644 --- a/generic/tclThreadStorage.c +++ b/generic/tclThreadStorage.c @@ -48,7 +48,7 @@ static struct { */ typedef struct { - void **tablePtr; /* The table of Tcl TSDs. */ + void **tablePtr; /* The table of Tcl TSDs. */ sig_atomic_t allocated; /* The size of the table in the current * thread. */ } TSDTable; diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 14c7087..c5477bf 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -21,7 +21,7 @@ typedef struct TimerHandler { Tcl_Time time; /* When timer is to fire. */ Tcl_TimerProc *proc; /* Function to call. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ Tcl_TimerToken token; /* Identifies handler so it can be deleted. */ struct TimerHandler *nextPtr; /* Next event in queue, or NULL for end of @@ -73,7 +73,7 @@ typedef struct AfterAssocData { typedef struct IdleHandler { Tcl_IdleProc *proc; /* Function to call. */ - void *clientData; /* Value to pass to proc. */ + void *clientData; /* Value to pass to proc. */ int generation; /* Used to distinguish older handlers from * recently-created ones. */ struct IdleHandler *nextPtr;/* Next in list of active handlers. */ @@ -251,7 +251,7 @@ Tcl_CreateTimerHandler( int milliseconds, /* How many milliseconds to wait before * invoking proc. */ Tcl_TimerProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { Tcl_Time time; @@ -619,7 +619,7 @@ TimerHandlerEventProc( void Tcl_DoWhenIdle( Tcl_IdleProc *proc, /* Function to invoke. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr; Tcl_Time blockTime; @@ -663,7 +663,7 @@ Tcl_DoWhenIdle( void Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ - void *clientData) /* Arbitrary value to pass to proc. */ + void *clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr, *prevPtr; IdleHandler *nextPtr; @@ -823,10 +823,10 @@ Tcl_AfterObjCmd( const char *arg = TclGetString(objv[1]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad argument \"%s\": must be" - " cancel, idle, info, or an integer", arg)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", - arg, (void *)NULL); + "bad argument \"%s\": must be" + " cancel, idle, info, or an integer", arg)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", + arg, (void *)NULL); return TCL_ERROR; } } @@ -952,7 +952,7 @@ Tcl_AfterObjCmd( "after#%d", afterPtr->id)); } } - Tcl_SetObjResult(interp, resultObj); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (objc != 3) { @@ -961,11 +961,11 @@ Tcl_AfterObjCmd( } afterPtr = GetAfterEvent(assocPtr, objv[2]); if (afterPtr == NULL) { - const char *eventStr = TclGetString(objv[2]); + const char *eventStr = TclGetString(objv[2]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "event \"%s\" doesn't exist", eventStr)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "EVENT", eventStr, (void *)NULL); + "event \"%s\" doesn't exist", eventStr)); + Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, (void *)NULL); return TCL_ERROR; } else { Tcl_Obj *resultListPtr; @@ -975,7 +975,7 @@ Tcl_AfterObjCmd( afterPtr->commandPtr); Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( (afterPtr->token == NULL) ? "idle" : "timer", -1)); - Tcl_SetObjResult(interp, resultListPtr); + Tcl_SetObjResult(interp, resultListPtr); } break; default: @@ -1043,17 +1043,17 @@ AfterDelay( if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } - if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) { - diff = 1; - } + if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) { + diff = 1; + } if (diff > 0) { Tcl_Sleep((int) diff); - if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) { - break; - } + if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) { + break; + } } else { - break; - } + break; + } } else { diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now); if (diff > TCL_TIME_MAXIMUM_SLICE) { @@ -1149,7 +1149,7 @@ GetAfterEvent( static void AfterProc( - void *clientData) /* Describes command to execute. */ + void *clientData) /* Describes command to execute. */ { AfterInfo *afterPtr = (AfterInfo *)clientData; AfterAssocData *assocPtr = afterPtr->assocPtr; @@ -1214,7 +1214,7 @@ AfterProc( static void FreeAfterPtr( - AfterInfo *afterPtr) /* Command to be deleted. */ + AfterInfo *afterPtr) /* Command to be deleted. */ { AfterInfo *prevPtr; AfterAssocData *assocPtr = afterPtr->assocPtr; @@ -1251,7 +1251,7 @@ FreeAfterPtr( static void AfterCleanupProc( - void *clientData, /* Points to AfterAssocData for the + void *clientData, /* Points to AfterAssocData for the * interpreter. */ TCL_UNUSED(Tcl_Interp *)) { diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 6c48f81..f4e9fe5 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -22,7 +22,7 @@ typedef struct { int flags; /* Operations for which Tcl command is to be * invoked. */ Tcl_Size length; /* Number of non-NUL chars. in command. */ - char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual + char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual * size will be as large as necessary to hold * command. This field must be the last in the * structure, so that it can be larger than 1 @@ -44,7 +44,7 @@ typedef struct { Tcl_Size length; /* Number of non-NUL chars. in command. */ Tcl_Trace stepTrace; /* Used for execution traces, when tracing * inside the given command */ - Tcl_Size startLevel; /* Used for bookkeeping with step execution + Tcl_Size startLevel; /* Used for bookkeeping with step execution * traces, store the level at which the step * trace was invoked */ char *startCmd; /* Used for bookkeeping with step execution @@ -56,7 +56,7 @@ typedef struct { * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ - char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual + char command[TCLFLEXARRAY]; /* Space for Tcl command to invoke. Actual * size will be as large as necessary to hold * command. This field must be the last in the * structure, so that it can be larger than 1 @@ -146,7 +146,7 @@ static int TraceVarEx(Tcl_Interp *interp, const char *part1, */ typedef struct { - void *clientData; /* Client data from Tcl_CreateTrace */ + void *clientData; /* Client data from Tcl_CreateTrace */ Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */ } StringTraceData; @@ -156,13 +156,13 @@ typedef struct { */ #define FOREACH_VAR_TRACE(interp, name, clientData) \ - (clientData) = NULL; \ - while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \ + (clientData) = NULL; \ + while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \ 0, TraceVarProc, (clientData))) != NULL) #define FOREACH_COMMAND_TRACE(interp, name, clientData) \ - (clientData) = NULL; \ - while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \ + (clientData) = NULL; \ + while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \ TraceCommandProc, (clientData))) != NULL) /* @@ -279,9 +279,8 @@ Tcl_TraceObjCmd( static int TraceExecutionObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, - /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + enum traceOptionsEnum optionIndex, /* Add, info or remove */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *command; @@ -384,7 +383,7 @@ TraceExecutionObjCmd( */ name = TclGetString(objv[3]); - if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } @@ -527,9 +526,8 @@ TraceExecutionObjCmd( static int TraceCommandObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, - /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + enum traceOptionsEnum optionIndex, /* Add, info or remove */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *command; @@ -618,7 +616,7 @@ TraceCommandObjCmd( */ name = TclGetString(objv[3]); - if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } @@ -722,9 +720,8 @@ TraceCommandObjCmd( static int TraceVariableObjCmd( Tcl_Interp *interp, /* Current interpreter. */ - enum traceOptionsEnum optionIndex, - /* Add, info or remove */ - Tcl_Size objc, /* Number of arguments. */ + enum traceOptionsEnum optionIndex, /* Add, info or remove */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *command; @@ -984,7 +981,7 @@ Tcl_TraceCommand( * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are * invoked upon cmdName. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { Command *cmdPtr; CommandTrace *tracePtr; @@ -1047,7 +1044,7 @@ Tcl_UntraceCommand( * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { CommandTrace *tracePtr; CommandTrace *prevPtr; @@ -1122,7 +1119,7 @@ Tcl_UntraceCommand( cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES; - /* + /* * Bug 3484621: up the interp's epoch if this is a BC'ed command */ @@ -1152,7 +1149,7 @@ Tcl_UntraceCommand( static void TraceCommandProc( - void *clientData, /* Information about the command trace. */ + void *clientData, /* Information about the command trace. */ Tcl_Interp *interp, /* Interpreter containing command. */ const char *oldName, /* Name of command being changed. */ const char *newName, /* New name of command. Empty string or NULL @@ -1297,7 +1294,7 @@ TclCheckExecutionTraces( Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ - Tcl_Size objc, /* Number of arguments for the command. */ + Tcl_Size objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; @@ -1403,7 +1400,7 @@ TclCheckInterpTraces( Command *cmdPtr, /* Points to command's Command struct. */ int code, /* The current result code. */ int traceFlags, /* Current tracing situation. */ - Tcl_Size objc, /* Number of arguments for the command. */ + Tcl_Size objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; @@ -1541,7 +1538,7 @@ TclCheckInterpTraces( static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ - Trace *tracePtr, /* Describes the trace function to call. */ + 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. */ @@ -1836,7 +1833,7 @@ TraceExecutionProc( static char * TraceVarProc( - void *clientData, /* Information about the variable trace. */ + void *clientData, /* Information about the variable trace. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable or array. */ const char *name2, /* Name of element within array; NULL means @@ -2019,10 +2016,10 @@ traceWrapperDelProc( Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Size level, /* Maximum nesting level */ + Tcl_Size level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc *proc, /* Trace callback */ - void *clientData, /* Client data for the callback */ + void *clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { @@ -2038,10 +2035,10 @@ Tcl_CreateObjTrace( Tcl_Trace Tcl_CreateObjTrace2( Tcl_Interp *interp, /* Tcl interpreter */ - Tcl_Size level, /* Maximum nesting level */ + Tcl_Size level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc2 *proc, /* Trace callback */ - void *clientData, /* Client data for the callback */ + void *clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { @@ -2127,11 +2124,11 @@ Tcl_CreateObjTrace2( Tcl_Trace Tcl_CreateTrace( Tcl_Interp *interp, /* Interpreter in which to create trace. */ - Tcl_Size level, /* Only call proc for commands at nesting + Tcl_Size level, /* Only call proc for commands at nesting * level<=argument level (1=>top level). */ Tcl_CmdTraceProc *proc, /* Function to call before executing each * command. */ - void *clientData) /* Arbitrary value word to pass to proc. */ + void *clientData) /* Arbitrary value word to pass to proc. */ { StringTraceData *data = (StringTraceData *)Tcl_Alloc(sizeof(StringTraceData)); @@ -2437,7 +2434,7 @@ TclCheckArrayTraces( int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - Var *arrayPtr, /* Pointer to array variable that contains the + 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. */ @@ -2471,7 +2468,7 @@ TclObjCallVarTraces( int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ - Var *arrayPtr, /* Pointer to array variable that contains the + 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. */ @@ -2550,15 +2547,15 @@ TclCallVarTraces( /* Keep the original pointer for possible use in an error message */ element = part2; if (part2 == NULL) { - if (TclIsVarArrayElement(varPtr)) { - Tcl_Obj *keyObj = VarHashGetKey(varPtr); - part2 = Tcl_GetString(keyObj); - } + if (TclIsVarArrayElement(varPtr)) { + Tcl_Obj *keyObj = VarHashGetKey(varPtr); + part2 = Tcl_GetString(keyObj); + } } else if ((flags & VAR_TRACED_UNSET) && !(flags & VAR_ARRAY_ELEMENT)) { - /* On unset traces, part2 has already been set by the caller, and - * the VAR_ARRAY_ELEMENT flag indicates whether the accessed - * variable actually has a second part, or is a scalar */ - element = NULL; + /* On unset traces, part2 has already been set by the caller, and + * the VAR_ARRAY_ELEMENT flag indicates whether the accessed + * variable actually has a second part, or is a scalar */ + element = NULL; } /* @@ -2694,7 +2691,7 @@ TclCallVarTraces( } else { Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state); } - DisposeTraceResult(disposeFlags, result); + DisposeTraceResult(disposeFlags,result); } else if (state) { if (code == TCL_OK) { code = Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state); @@ -2779,7 +2776,7 @@ Tcl_UntraceVar2( * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function associated with trace. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; VarTrace *prevPtr, *nextPtr; @@ -2982,7 +2979,7 @@ Tcl_TraceVar2( * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function to call when specified ops are * invoked upon varName. */ - void *clientData) /* Arbitrary argument to pass to proc. */ + void *clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; int result; diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 8bda8ac..03ea8b6 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -132,7 +132,7 @@ TclUtfCount( * invalid in UTF-8. This might be because it is an overlong * encoding, or because it encodes something out of the proper range. * - * Given a pointer to the bytes \xF8 or \xFC, this routine will + * Given a pointer to the bytes \xF8 or \xFC , this routine will * try to read beyond the end of the "bounds" table. Callers must * prevent this. * @@ -161,8 +161,7 @@ static const unsigned char bounds[28] = { static int Invalid( - const char *src) /* Points to lead byte of a UTF-8 byte - * sequence. */ + const char *src) /* Points to lead byte of a UTF-8 byte sequence */ { unsigned char byte = UCHAR(*src); int index; @@ -310,7 +309,7 @@ three: char * Tcl_UniCharToUtfDString( - const int *uniStr, /* Unicode string to convert to UTF-8. */ + const int *uniStr, /* Unicode string to convert to UTF-8. */ Tcl_Size uniLength, /* Length of Unicode string. Negative for nul * terminated string */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended @@ -441,9 +440,9 @@ static const unsigned short cp1252[32] = { Tcl_Size Tcl_UtfToUniChar( - const char *src, /* The UTF-8 string. */ - int *chPtr) /* Filled with the Unicode character - * represented by the UTF-8 string. */ + const char *src, /* The UTF-8 string. */ + int *chPtr)/* Filled with the Unicode character represented by + * the UTF-8 string. */ { int byte; @@ -501,8 +500,7 @@ Tcl_UtfToUniChar( * represents itself. */ } else if (byte < 0xF5) { - if (((src[1] & 0xC0) == 0x80) - && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { + if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { /* * Four-byte-character lead byte followed by three trail bytes. */ @@ -525,10 +523,9 @@ Tcl_UtfToUniChar( Tcl_Size Tcl_UtfToChar16( - const char *src, /* The UTF-8 string. */ - unsigned short *chPtr) /* Filled with the Tcl_UniChar represented by - * the UTF-8 string. This could be a surrogate - * too. */ + const char *src, /* The UTF-8 string. */ + unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by + * the UTF-8 string. This could be a surrogate too. */ { unsigned short byte; @@ -804,9 +801,9 @@ Tcl_UtfCharComplete( Tcl_Size Tcl_NumUtfChars( - const char *src, /* The UTF-8 string to measure. */ - Tcl_Size length) /* The length of the string in bytes, or - * negative value for strlen(src). */ + const char *src, /* The UTF-8 string to measure. */ + Tcl_Size length) /* The length of the string in bytes, or + * negative value for strlen(src). */ { Tcl_UniChar ch = 0; Tcl_Size i = 0; @@ -856,9 +853,9 @@ Tcl_NumUtfChars( Tcl_Size TclNumUtfChars( - const char *src, /* The UTF-8 string to measure. */ - Tcl_Size length) /* The length of the string in bytes, or - * negative for strlen(src). */ + const char *src, /* The UTF-8 string to measure. */ + Tcl_Size length) /* The length of the string in bytes, or + * negative for strlen(src). */ { unsigned short ch = 0; Tcl_Size i = 0; @@ -1180,8 +1177,8 @@ Tcl_UtfPrev( int Tcl_UniCharAtIndex( - const char *src, /* The UTF-8 string to dereference. */ - Tcl_Size index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string to dereference. */ + Tcl_Size index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int i = 0; @@ -1216,8 +1213,8 @@ Tcl_UniCharAtIndex( const char * Tcl_UtfAtIndex( - const char *src, /* The UTF-8 string. */ - Tcl_Size index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string. */ + Tcl_Size index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; @@ -1229,8 +1226,8 @@ Tcl_UtfAtIndex( const char * TclUtfAtIndex( - const char *src, /* The UTF-8 string. */ - Tcl_Size index) /* The position of the desired character. */ + const char *src, /* The UTF-8 string. */ + Tcl_Size index) /* The position of the desired character. */ { unsigned short ch = 0; Tcl_Size len = 0; @@ -1493,7 +1490,7 @@ int TclpUtfNcmp2( const void *csPtr, /* UTF string to compare to ct. */ const void *ctPtr, /* UTF string cs is compared to. */ - size_t numBytes) /* Number of *bytes* to compare. */ + size_t numBytes) /* Number of *bytes* to compare. */ { const char *cs = (const char *)csPtr; const char *ct = (const char *)ctPtr; @@ -1526,8 +1523,8 @@ TclpUtfNcmp2( * * Tcl_UtfNcmp -- * - * Compare at most numChars chars (not bytes) of string cs to string ct. - * Both cs and ct are assumed to be at least numChars chars long. + * Compare at most numChars chars (not bytes) of string cs to string ct. Both cs + * and ct are assumed to be at least numChars chars long. * * Results: * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. @@ -1542,7 +1539,7 @@ int TclUtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF-16 chars to compare. */ + size_t numChars) /* Number of UTF-16 chars to compare. */ { unsigned short ch1 = 0, ch2 = 0; @@ -1555,18 +1552,18 @@ TclUtfNcmp( while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. This should be called - * only when both strings are of at least n UTF-16 chars long (no - * need for \0 check) + * only when both strings are of at least n UTF-16 chars long (no need for \0 + * check) */ cs += Tcl_UtfToChar16(cs, &ch1); ct += Tcl_UtfToChar16(ct, &ch2); if (ch1 != ch2) { /* Surrogates always report higher than non-surrogates */ - if ((ch1 & 0xFC00) == 0xD800) { - if ((ch2 & 0xFC00) != 0xD800) { - return ch1; - } + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; } @@ -1580,7 +1577,7 @@ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1611,9 +1608,9 @@ Tcl_UtfNcmp( * * Tcl_UtfNcasecmp -- * - * Compare at most numChars chars (not bytes) of string cs to string ct - * case insensitive. Both cs and ct are assumed to be at least numChars - * UTF-16 chars long. + * Compare at most numChars chars (not bytes) of string cs to string ct case + * insensitive. Both cs and ct are assumed to be at least numChars UTF + * chars long. * * Results: * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. @@ -1628,7 +1625,7 @@ int TclUtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF-16 chars to compare. */ + size_t numChars) /* Number of UTF-16 chars to compare. */ { unsigned short ch1 = 0, ch2 = 0; @@ -1642,10 +1639,10 @@ TclUtfNcasecmp( ct += Tcl_UtfToChar16(ct, &ch2); if (ch1 != ch2) { /* Surrogates always report higher than non-surrogates */ - if ((ch1 & 0xFC00) == 0xD800) { - if ((ch2 & 0xFC00) != 0xD800) { - return ch1; - } + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } } else if ((ch2 & 0xFC00) == 0xD800) { return -ch2; } @@ -1663,7 +1660,7 @@ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1912,7 +1909,7 @@ Tcl_Char16Len( Tcl_Size Tcl_UniCharLen( - const int *uniStr) /* Unicode string to find length of. */ + const int *uniStr) /* Unicode string to find length of. */ { Tcl_Size len = 0; @@ -1944,7 +1941,7 @@ int TclUniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { #if defined(WORDS_BIGENDIAN) /* @@ -1972,8 +1969,8 @@ TclUniCharNcmp( * * TclUniCharNcasecmp -- * - * Compare at most numChars chars (not bytes) of string ucs to string uct - * case insensitive. Both ucs and uct are assumed to be at least numChars + * Compare at most numChars chars (not bytes) of string ucs to string uct case + * insensitive. Both ucs and uct are assumed to be at least numChars * chars long. * * Results: @@ -1989,7 +1986,7 @@ int TclUniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of chars to compare. */ + size_t numChars) /* Number of chars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 33ff5d4..3043fed 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -124,11 +124,11 @@ static int FindElement(Tcl_Interp *interp, const char *string, */ static const Tcl_ObjType endOffsetType = { - "end-offset", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - NULL, /* updateStringProc */ - NULL, /* setFromAnyProc */ + "end-offset", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL, /* setFromAnyProc */ TCL_OBJTYPE_V1(TclLengthOne) }; @@ -946,9 +946,9 @@ Tcl_SplitList( Tcl_Size Tcl_ScanElement( - const char *src, /* String to convert to list element. */ - int *flagPtr) /* Where to store information to guide - * Tcl_ConvertCountedElement. */ + const char *src, /* String to convert to list element. */ + int *flagPtr) /* Where to store information to guide + * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, TCL_INDEX_NONE, flagPtr); } @@ -1036,7 +1036,7 @@ TclScanElement( Tcl_Size extra = 0; /* Count of number of extra bytes needed for * formatted element, assuming we use escape * sequences in formatting. */ - Tcl_Size bytesNeeded; /* Buffer length computed to complete the + Tcl_Size bytesNeeded; /* Buffer length computed to complete the * element formatting in the selected mode. */ #if COMPAT int preferEscape = 0; /* Use preferences to track whether to use */ @@ -1083,96 +1083,96 @@ TclScanElement( } while (length) { - if (CHAR_TYPE(*p) != TYPE_NORMAL) { - switch (*p) { - case '{': /* TYPE_BRACE */ + if (CHAR_TYPE(*p) != TYPE_NORMAL) { + switch (*p) { + case '{': /* TYPE_BRACE */ #if COMPAT - braceCount++; + braceCount++; #endif /* COMPAT */ - extra++; /* Escape '{' => '\{' */ - nestingLevel++; - break; - case '}': /* TYPE_BRACE */ + extra++; /* Escape '{' => '\{' */ + nestingLevel++; + break; + case '}': /* TYPE_BRACE */ #if COMPAT - braceCount++; + braceCount++; #endif /* COMPAT */ - extra++; /* Escape '}' => '\}' */ - if (nestingLevel-- < 1) { - /* - * Unbalanced braces! Cannot format with brace quoting. - */ + extra++; /* Escape '}' => '\}' */ + if (nestingLevel-- < 1) { + /* + * Unbalanced braces! Cannot format with brace quoting. + */ - requireEscape = 1; - } - break; - case ']': /* TYPE_CLOSE_BRACK */ - case '"': /* TYPE_SPACE */ + requireEscape = 1; + } + break; + case ']': /* TYPE_CLOSE_BRACK */ + case '"': /* TYPE_SPACE */ #if COMPAT - forbidNone = 1; - extra++; /* Escapes all just prepend a backslash */ - preferEscape = 1; - break; + forbidNone = 1; + extra++; /* Escapes all just prepend a backslash */ + preferEscape = 1; + break; #else - /* FLOW THROUGH */ + /* FLOW THROUGH */ #endif /* COMPAT */ - case '[': /* TYPE_SUBS */ - case '$': /* TYPE_SUBS */ - case ';': /* TYPE_COMMAND_END */ - forbidNone = 1; - extra++; /* Escape sequences all one byte longer. */ + case '[': /* TYPE_SUBS */ + case '$': /* TYPE_SUBS */ + case ';': /* TYPE_COMMAND_END */ + forbidNone = 1; + extra++; /* Escape sequences all one byte longer. */ #if COMPAT - preferBrace = 1; + preferBrace = 1; #endif /* COMPAT */ + break; + case '\\': /* TYPE_SUBS */ + extra++; /* Escape '\' => '\\' */ + if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) { + /* + * Final backslash. Cannot format with brace quoting. + */ + + requireEscape = 1; break; - case '\\': /* TYPE_SUBS */ - extra++; /* Escape '\' => '\\' */ - if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) { - /* - * Final backslash. Cannot format with brace quoting. - */ - - requireEscape = 1; - break; - } - if (p[1] == '\n') { - extra++; /* Escape newline => '\n', one byte longer */ + } + if (p[1] == '\n') { + extra++; /* Escape newline => '\n', one byte longer */ - /* - * Backslash newline sequence. Brace quoting not permitted. - */ + /* + * Backslash newline sequence. Brace quoting not permitted. + */ - requireEscape = 1; - length -= (length > 0); - p++; - break; - } - if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) { - extra++; /* Escape sequences all one byte longer. */ - length -= (length > 0); - p++; - } - forbidNone = 1; + requireEscape = 1; + length -= (length > 0); + p++; + break; + } + if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) { + extra++; /* Escape sequences all one byte longer. */ + length -= (length > 0); + p++; + } + forbidNone = 1; #if COMPAT - preferBrace = 1; + preferBrace = 1; #endif /* COMPAT */ - break; - case '\0': /* TYPE_SUBS */ - if (length == TCL_INDEX_NONE) { - goto endOfString; - } - /* TODO: Panic on improper encoding? */ - break; - default: - if (TclIsSpaceProcM(*p)) { - forbidNone = 1; - extra++; /* Escape sequences all one byte longer. */ + break; + case '\0': /* TYPE_SUBS */ + if (length == TCL_INDEX_NONE) { + goto endOfString; + } + /* TODO: Panic on improper encoding? */ + break; + default: + if (TclIsSpaceProcM(*p)) { + forbidNone = 1; + extra++; /* Escape sequences all one byte longer. */ #if COMPAT - preferBrace = 1; + preferBrace = 1; #endif - } - break; } + break; } + } length -= (length > 0); p++; } @@ -1323,9 +1323,9 @@ TclScanElement( Tcl_Size 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. */ + 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, TCL_INDEX_NONE, dst, flags); } @@ -1353,7 +1353,7 @@ Tcl_ConvertElement( Tcl_Size Tcl_ConvertCountedElement( - const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ @@ -1386,7 +1386,7 @@ Tcl_ConvertCountedElement( Tcl_Size TclConvertElement( - const char *src, /* Source information for list element. */ + const char *src, /* Source information for list element. */ Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ @@ -1406,8 +1406,7 @@ TclConvertElement( * No matter what the caller demands, empty string must be braced! */ - if ((src == NULL) || (length == 0) - || (*src == '\0' && length == TCL_INDEX_NONE)) { + if ((src == NULL) || (length == 0) || (*src == '\0' && length == TCL_INDEX_NONE)) { p[0] = '{'; p[1] = '}'; return 2; @@ -1568,7 +1567,7 @@ TclConvertElement( char * Tcl_Merge( - Tcl_Size argc, /* How many strings to merge. */ + Tcl_Size argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { #define LOCAL_SIZE 64 @@ -1645,14 +1644,14 @@ Tcl_Merge( Tcl_Size TclTrimRight( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim) /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim) /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (trim[numTrim] == '\0'). */ { const char *pp, *p = bytes + numBytes; int ch1, ch2; @@ -1724,14 +1723,14 @@ TclTrimRight( Tcl_Size TclTrimLeft( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim) /* ...and its length in bytes */ - /* Calls to TclUtfToUniChar() in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim) /* ...and its length in bytes */ + /* Calls to TclUtfToUniChar() in this routine + * rely on (trim[numTrim] == '\0'). */ { const char *p = bytes; int ch1, ch2; @@ -1798,14 +1797,14 @@ TclTrimLeft( Tcl_Size TclTrim( - const char *bytes, /* String to be trimmed... */ - Tcl_Size numBytes, /* ...and its length in bytes */ - /* Calls in this routine - * rely on (bytes[numBytes] == '\0'). */ - const char *trim, /* String of trim characters... */ - Tcl_Size numTrim, /* ...and its length in bytes */ - /* Calls in this routine - * rely on (trim[numTrim] == '\0'). */ + const char *bytes, /* String to be trimmed... */ + Tcl_Size numBytes, /* ...and its length in bytes */ + /* Calls in this routine + * rely on (bytes[numBytes] == '\0'). */ + const char *trim, /* String of trim characters... */ + Tcl_Size numTrim, /* ...and its length in bytes */ + /* Calls in this routine + * rely on (trim[numTrim] == '\0'). */ Tcl_Size *trimRightPtr) /* Offset from the end of the string. */ { Tcl_Size trimLeft = 0, trimRight = 0; @@ -1860,7 +1859,7 @@ TclTrim( char * Tcl_Concat( - Tcl_Size argc, /* Number of strings to concatenate. */ + Tcl_Size argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { Tcl_Size i, needSpace = 0, bytesNeeded = 0; @@ -2338,11 +2337,11 @@ Tcl_StringCaseMatch( int TclByteArrayMatch( const unsigned char *string,/* String. */ - Tcl_Size strLen, /* Length of String */ + Tcl_Size strLen, /* Length of String */ const unsigned char *pattern, /* Pattern, which may contain special * characters. */ - Tcl_Size ptnLen, /* Length of Pattern */ + Tcl_Size ptnLen, /* Length of Pattern */ TCL_UNUSED(int) /*flags*/) { const unsigned char *stringEnd, *patternEnd; @@ -2729,7 +2728,6 @@ Tcl_DStringAppendElement( * Backtrack over all whitespace. */ while ((--dst >= dsPtr->string) && TclIsSpaceProcM(*dst)) { - // empty body } /* Call again without whitespace to confound things. */ @@ -2811,7 +2809,7 @@ Tcl_DStringAppendElement( void Tcl_DStringSetLength( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ - Tcl_Size length) /* New length for dynamic string. */ + Tcl_Size length) /* New length for dynamic string. */ { Tcl_Size newsize; @@ -3244,10 +3242,9 @@ TclNeedSpace( */ while ((--end >= start) && (*end == '{')) { - // empty body } if (end < start) { - return 0; + return 0; } /* @@ -3301,7 +3298,7 @@ Tcl_Size TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ - Tcl_WideInt n) /* The integer to format. */ + Tcl_WideInt n) /* The integer to format. */ { Tcl_WideUInt intVal; int i = 0, numFormatted, j; @@ -3363,15 +3360,15 @@ TclFormatInt( static int GetWideForIndex( - Tcl_Interp *interp, /* Interpreter to use for error reporting. If + Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ - Tcl_Obj *objPtr, /* Points to the value to be parsed */ - Tcl_WideInt endValue, /* The value to be stored at *widePtr if + Tcl_Obj *objPtr, /* Points to the value to be parsed */ + Tcl_WideInt endValue, /* The value to be stored at *widePtr if * objPtr holds "end". - * NOTE: this value may be TCL_INDEX_NONE. */ - Tcl_WideInt *widePtr) /* Location filled in with a wide integer - * representing an index. */ + * NOTE: this value may be TCL_INDEX_NONE. */ + Tcl_WideInt *widePtr) /* Location filled in with a wide integer + * representing an index. */ { int numType; void *cd; @@ -3381,7 +3378,7 @@ GetWideForIndex( if (numType == TCL_NUMBER_INT) { /* objPtr holds an integer in the signed wide range */ *widePtr = *(Tcl_WideInt *)cd; - if ((*widePtr < 0)) { + if ((*widePtr < 0)) { *widePtr = (endValue == -1) ? WIDE_MIN : -1; } return TCL_OK; @@ -3412,7 +3409,7 @@ GetWideForIndex( * TCL_SIZE_MAX. Negative values are returned as TCL_INDEX_NONE (-1). * * Callers should pass reasonable values for endValue - one in the - * valid index range or TCL_INDEX_NONE (-1), for example for an empty + * valid index range or TCL_INDEX_NONE (-1), for example for an empty * list. * * Results: @@ -3456,10 +3453,10 @@ Tcl_GetIntForIndex( } else if (wide > TCL_SIZE_MAX) { *indexPtr = TCL_SIZE_MAX; /* Beyond max possible index */ } else if (wide < -1-TCL_SIZE_MAX) { - *indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */ - } else if ((wide < 0) && (endValue >= 0)) { - *indexPtr = TCL_INDEX_NONE; /* No clue why this special case */ - } else { + *indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */ + } else if ((wide < 0) && (endValue >= 0)) { + *indexPtr = TCL_INDEX_NONE; /* No clue why this special case */ + } else { *indexPtr = (Tcl_Size) wide; } } @@ -3483,7 +3480,7 @@ Tcl_GetIntForIndex( * -1: Index "end" * 0: Index "0" * WIDE_MAX-1: Index "end+n", for any n > 1. Distinguish from end+1 for - * commands like lset. + * commands like lset. * WIDE_MAX: Index "end+1" * * Results: @@ -3498,11 +3495,11 @@ Tcl_GetIntForIndex( static int GetEndOffsetFromObj( Tcl_Interp *interp, - Tcl_Obj *objPtr, /* Pointer to the object to parse */ - Tcl_WideInt endValue, /* The value to be stored at "widePtr" if - * "objPtr" holds "end". */ - Tcl_WideInt *widePtr) /* Location filled in with an integer - * representing an index. */ + Tcl_Obj *objPtr, /* Pointer to the object to parse */ + Tcl_WideInt endValue, /* The value to be stored at "widePtr" if + * "objPtr" holds "end". */ + Tcl_WideInt *widePtr) /* Location filled in with an integer + * representing an index. */ { Tcl_ObjInternalRep *irPtr; Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */ @@ -3535,14 +3532,14 @@ GetEndOffsetFromObj( */ if ((TclMaxListLength(bytes, TCL_INDEX_NONE, NULL) > 1) /* If it's possible, do the full list parse. */ - && (TCL_OK == TclListObjLength(NULL, objPtr, &length)) - && (length > 1)) { - goto parseError; + && (TCL_OK == TclListObjLength(NULL, objPtr, &length)) + && (length > 1)) { + goto parseError; } /* Passed the list screen, so parse for index arithmetic expression */ - if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, - TCL_INDEX_NONE, &opPtr, TCL_PARSE_INTEGER_ONLY)) { + if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE, &opPtr, + TCL_PARSE_INTEGER_ONLY)) { Tcl_WideInt w1=0, w2=0; /* value starts with valid integer... */ @@ -3701,12 +3698,12 @@ GetEndOffsetFromObj( if (offset == WIDE_MAX) { /* * Encodes end+1. This is distinguished from end+n as noted - * in function header. + * in function header. * NOTE: this may wrap around if the caller passes (as lset does) * listLen-1 as endValue and and listLen is 0. The -1 will be * interpreted as FF...FF and adding 1 will result in 0 which * is what we want. Callers like lset which pass in listLen-1 == -1 - * as endValue will have to adjust accordingly. + * as endValue will have to adjust accordingly. */ *widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1; } else if (offset == WIDE_MIN) { @@ -3727,14 +3724,14 @@ GetEndOffsetFromObj( /* Report a parse error. */ parseError: if (interp != NULL) { - char * bytes = TclGetString(objPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad index \"%s\": must be integer?[+-]integer? or" - " end?[+-]integer?", bytes)); - if (!strncmp(bytes, "end-", 4)) { - bytes += 4; - } - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL); + char * bytes = TclGetString(objPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\": must be integer?[+-]integer? or" + " end?[+-]integer?", bytes)); + if (!strncmp(bytes, "end-", 4)) { + bytes += 4; + } + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL); } return TCL_ERROR; @@ -3744,68 +3741,68 @@ GetEndOffsetFromObj( *---------------------------------------------------------------------- * * TclIndexEncode -- - * IMPORTANT: function only encodes indices in the range that fits within - * an "int" type. Do NOT change this as the byte code compiler and engine - * which call this function cannot handle wider index types. Indices - * outside the range will result in the function returning an error. + * IMPORTANT: function only encodes indices in the range that fits within + * an "int" type. Do NOT change this as the byte code compiler and engine + * which call this function cannot handle wider index types. Indices + * outside the range will result in the function returning an error. * - * Parse objPtr to determine if it is an index value. Two cases + * Parse objPtr to determine if it is an index value. Two cases * are possible. The value objPtr might be parsed as an absolute * index value in the Tcl_Size range. Note that this includes * index values that are integers as presented and it includes index - * arithmetic expressions. + * arithmetic expressions. * - * The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX. - * This means the largest supported character length is also TCL_SIZE_MAX, - * and the index of the last character in a string of length TCL_SIZE_MAX - * is TCL_SIZE_MAX-1. Thus the absolute index values that can be + * The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX. + * This means the largest supported character length is also TCL_SIZE_MAX, + * and the index of the last character in a string of length TCL_SIZE_MAX + * is TCL_SIZE_MAX-1. Thus the absolute index values that can be * directly meaningful as an index into either a list or a string are * integer values in the range 0 to TCL_SIZE_MAX - 1. * - * This function however can only handle integer indices in the range - * 0 : INT_MAX-1. - * - * Any absolute index value parsed outside that range is encoded - * using the before and after values passed in by the - * caller as the encoding to use for indices that are either - * less than or greater than the usable index range. TCL_INDEX_NONE - * is available as a good choice for most callers to use for - * after. Likewise, the value TCL_INDEX_NONE is good for - * most callers to use for before. Other values are possible - * when the caller knows it is helpful in producing its own behavior - * for indices before and after the indexed item. - * - * A token can also be parsed as an end-relative index expression. - * All end-relative expressions that indicate an index larger - * than end (end+2, end--5) point beyond the end of the indexed - * collection, and can be encoded as after. The end-relative - * expressions that indicate an index less than or equal to end - * are encoded relative to the value TCL_INDEX_END (-2). The - * index "end" is encoded as -2, down to the index "end-0x7FFFFFFE" - * which is encoded as INT_MIN. Since the largest index into a - * string possible in Tcl 8 is 0x7FFFFFFE, the interpretation of - * "end-0x7FFFFFFE" for that largest string would be 0. Thus, - * if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed, - * they can be encoded with the before value. + * This function however can only handle integer indices in the range + * 0 : INT_MAX-1. + * + * Any absolute index value parsed outside that range is encoded + * using the before and after values passed in by the + * caller as the encoding to use for indices that are either + * less than or greater than the usable index range. TCL_INDEX_NONE + * is available as a good choice for most callers to use for + * after. Likewise, the value TCL_INDEX_NONE is good for + * most callers to use for before. Other values are possible + * when the caller knows it is helpful in producing its own behavior + * for indices before and after the indexed item. + * + * A token can also be parsed as an end-relative index expression. + * All end-relative expressions that indicate an index larger + * than end (end+2, end--5) point beyond the end of the indexed + * collection, and can be encoded as after. The end-relative + * expressions that indicate an index less than or equal to end + * are encoded relative to the value TCL_INDEX_END (-2). The + * index "end" is encoded as -2, down to the index "end-0x7FFFFFFE" + * which is encoded as INT_MIN. Since the largest index into a + * string possible in Tcl 8 is 0x7FFFFFFE, the interpretation of + * "end-0x7FFFFFFE" for that largest string would be 0. Thus, + * if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed, + * they can be encoded with the before value. * * Returns: - * TCL_OK if parsing succeeded, and TCL_ERROR if it failed or the - * index does not fit in an int type. + * TCL_OK if parsing succeeded, and TCL_ERROR if it failed or the + * index does not fit in an int type. * * Side effects: - * When TCL_OK is returned, the encoded index value is written - * to *indexPtr. + * When TCL_OK is returned, the encoded index value is written + * to *indexPtr. * *---------------------------------------------------------------------- */ int TclIndexEncode( - Tcl_Interp *interp, /* For error reporting, may be NULL */ - Tcl_Obj *objPtr, /* Index value to parse */ - int before, /* Value to return for index before beginning */ - int after, /* Value to return for index after end */ - int *indexPtr) /* Where to write the encoded answer, not NULL */ + Tcl_Interp *interp, /* For error reporting, may be NULL */ + Tcl_Obj *objPtr, /* Index value to parse */ + int before, /* Value to return for index before beginning */ + int after, /* Value to return for index after end */ + int *indexPtr) /* Where to write the encoded answer, not NULL */ { Tcl_WideInt wide; int idx; @@ -3924,8 +3921,9 @@ TclIndexEncode( rangeerror: if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "index \"%s\" out of range", TclGetString(objPtr))); + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("index \"%s\" out of range", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (void *)NULL); } return TCL_ERROR; @@ -3948,8 +3946,8 @@ rangeerror: Tcl_Size TclIndexDecode( - int encoded, /* Value to decode */ - Tcl_Size endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ + int encoded, /* Value to decode */ + Tcl_Size endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ { if (encoded > TCL_INDEX_END) { return encoded; @@ -3978,8 +3976,8 @@ TclIndexDecode( */ int TclCommandWordLimitError( - Tcl_Interp *interp, /* May be NULL */ - Tcl_Size count) /* If <= 0, "unknown" */ + Tcl_Interp *interp, /* May be NULL */ + Tcl_Size count) /* If <= 0, "unknown" */ { if (interp) { if (count > 0) { @@ -4045,11 +4043,11 @@ static Tcl_HashTable * GetThreadHash( Tcl_ThreadDataKey *keyPtr) { - Tcl_HashTable **tablePtrPtr = (Tcl_HashTable **) - Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *)); + Tcl_HashTable **tablePtrPtr = + (Tcl_HashTable **)Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *)); if (NULL == *tablePtrPtr) { - *tablePtrPtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + *tablePtrPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr); Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS); } @@ -4242,7 +4240,7 @@ TclGetProcessGlobalValue( Tcl_MutexLock(&pgvPtr->mutex); if ((NULL == pgvPtr->value) && (pgvPtr->proc)) { pgvPtr->epoch++; - pgvPtr->proc(&pgvPtr->value, &pgvPtr->numBytes, &pgvPtr->encoding); + pgvPtr->proc(&pgvPtr->value,&pgvPtr->numBytes,&pgvPtr->encoding); if (pgvPtr->value == NULL) { Tcl_Panic("PGV Initializer did not initialize"); } diff --git a/generic/tclVar.c b/generic/tclVar.c index 410b7ef..41bfa39 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -252,7 +252,7 @@ static const Tcl_ObjType localVarNameType = { TCL_OBJTYPE_V0 }; -#define LocalSetInternalRep(objPtr, index, namePtr) \ +#define LocalSetInternalRep(objPtr, index, namePtr) \ do { \ Tcl_ObjInternalRep ir; \ Tcl_Obj *ptr = (namePtr); \ @@ -262,12 +262,12 @@ static const Tcl_ObjType localVarNameType = { Tcl_StoreInternalRep((objPtr), &localVarNameType, &ir); \ } while (0) -#define LocalGetInternalRep(objPtr, index, name) \ +#define LocalGetInternalRep(objPtr, index, name) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &localVarNameType); \ - (name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ - (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &localVarNameType); \ + (name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ + (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \ } while (0) static const Tcl_ObjType parsedVarNameType = { @@ -276,7 +276,7 @@ static const Tcl_ObjType parsedVarNameType = { TCL_OBJTYPE_V0 }; -#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \ +#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \ do { \ Tcl_ObjInternalRep ir; \ Tcl_Obj *ptr1 = (arrayPtr); \ @@ -285,16 +285,16 @@ static const Tcl_ObjType parsedVarNameType = { if (ptr2) {Tcl_IncrRefCount(ptr2);} \ ir.twoPtrValue.ptr1 = ptr1; \ ir.twoPtrValue.ptr2 = ptr2; \ - Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir); \ + Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir); \ } while (0) -#define ParsedGetInternalRep(objPtr, parsed, array, elem) \ +#define ParsedGetInternalRep(objPtr, parsed, array, elem) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &parsedVarNameType); \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &parsedVarNameType); \ (parsed) = (irPtr != NULL); \ - (array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ - (elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ + (array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ + (elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) Var * @@ -344,8 +344,8 @@ NotArrayError( { const char *nameStr = TclGetString(name); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" isn't an array", nameStr)); + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("\"%s\" isn't an array", nameStr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, (char *)NULL); return TCL_ERROR; } @@ -531,7 +531,7 @@ TclLookupVar( Var * TclObjLookupVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ - Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an + 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. */ @@ -541,10 +541,10 @@ TclObjLookupVar( const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ - int createPart1, /* If 1, create hash table entry for part 1 of + int createPart1, /* If 1, create hash table entry for part 1 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ - int createPart2, /* If 1, create hash table entry for part 2 of + int createPart2, /* If 1, create hash table entry for part 2 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var **arrayPtrPtr) /* If the name refers to an element of an @@ -591,10 +591,10 @@ TclObjLookupVarEx( const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ - int createPart1, /* If 1, create hash table entry for part 1 of + int createPart1, /* If 1, create hash table entry for part 1 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ - int createPart2, /* If 1, create hash table entry for part 2 of + int createPart2, /* If 1, create hash table entry for part 2 of * name, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var **arrayPtrPtr) /* If the name refers to an element of an @@ -604,7 +604,7 @@ TclObjLookupVarEx( { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; - Var *varPtr; /* Points to the variable's in-frame Var + Var *varPtr; /* Points to the variable's in-frame Var * structure. */ const char *errMsg = NULL; int index, parsed = 0; @@ -827,7 +827,7 @@ TclLookupSimpleVar( int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG * bits matter. */ - int create, /* If 1, create hash table entry for varname, + int create, /* If 1, create hash table entry for varname, * if it doesn't already exist. If 0, return * error if it doesn't exist. */ const char **errMsgPtr, @@ -1025,7 +1025,7 @@ TclLookupSimpleVar( * element's name. * * Results: - * The return value is a pointer to the variable structure, or NULL if + * The return value is a pointer to the variable structure , or NULL if * the variable couldn't be found. * * If arrayPtr points to a variable that isn't an array and createPart1 @@ -1060,15 +1060,15 @@ TclLookupArrayElement( Tcl_Obj *arrayNamePtr, /* This is the name of the array, or NULL if * index>= 0. */ Tcl_Obj *elNamePtr, /* Name of element within array. */ - int flags, /* Only TCL_LEAVE_ERR_MSG bit matters. */ + int flags, /* Only TCL_LEAVE_ERR_MSG bit matters. */ const char *msg, /* Verb to use in error messages, e.g. "read" * or "set". Only needed if TCL_LEAVE_ERR_MSG * is set in flags. */ - int createArray, /* If 1, transform arrayName to be an array if + int createArray, /* If 1, transform arrayName to be an array if * it isn't one yet and the transformation is * possible. If 0, return error if it isn't * already an array. */ - int createElem, /* If 1, create hash table entry for the + int createElem, /* If 1, create hash table entry for the * element, if it doesn't already exist. If 0, * return error if it doesn't exist. */ Var *arrayPtr, /* Pointer to the array's Var structure. */ @@ -1277,10 +1277,10 @@ 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 + 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 + 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 @@ -1336,7 +1336,7 @@ TclPtrGetVar( * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ - int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { if (varPtr == NULL) { @@ -1375,14 +1375,14 @@ Tcl_Obj * TclPtrGetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - Var *varPtr, /* The variable to be read.*/ + 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. */ - int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is @@ -1483,14 +1483,14 @@ TclPtrGetVarIdx( int Tcl_SetObjCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ + 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); + varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG); if (varValueObj == NULL) { return TCL_ERROR; } @@ -1660,10 +1660,10 @@ 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 + 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 + 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. */ @@ -1731,7 +1731,7 @@ TclPtrSetVar( Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr, /* New value for variable. */ - int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { if (varPtr == NULL) { @@ -1900,7 +1900,7 @@ 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 *varPtr, /* Reference to the variable to set. */ Var *arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ @@ -1910,7 +1910,7 @@ TclPtrSetVarIdx( Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ Tcl_Obj *newValuePtr, /* New value for variable. */ - int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ int index) /* Index of local var where part1 is to be * found. */ @@ -1949,7 +1949,7 @@ TclPtrSetVarIdx( */ if (TclIsVarConstant(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST, index); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST,index); Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL); } goto earlyError; @@ -1961,7 +1961,7 @@ TclPtrSetVarIdx( if (TclIsVarArray(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY, index); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY,index); Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", (char *)NULL); } goto earlyError; @@ -2169,7 +2169,7 @@ TclPtrIncrObjVar( * part1Ptr. */ Tcl_Obj *incrPtr, /* Increment value. */ /* TODO: Which of these flag values really make sense? */ - int flags) /* Various flags that tell how to incr value: + int flags) /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ @@ -2225,7 +2225,7 @@ TclPtrIncrObjVarIdx( * part1Ptr. */ Tcl_Obj *incrPtr, /* Increment value. */ /* TODO: Which of these flag values really make sense? */ - int flags, /* Various flags that tell how to incr value: + int flags, /* Various flags that tell how to incr value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ @@ -2240,7 +2240,7 @@ TclPtrIncrObjVarIdx( */ if (TclIsVarConstant(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST, index); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST,index); Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL); } return NULL; @@ -2414,7 +2414,7 @@ TclPtrUnsetVar( * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ - int flags) /* OR-ed combination of any of + int flags) /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { @@ -2477,7 +2477,7 @@ TclPtrUnsetVarIdx( */ if (TclIsVarConstant(varPtr)) { if (flags & TCL_LEAVE_ERR_MSG) { - TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST, index); + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST,index); Tcl_SetErrorCode(interp, "TCL", "UNSET", "CONST", (void *)NULL); } return TCL_ERROR; @@ -2505,8 +2505,7 @@ TclPtrUnsetVarIdx( if (result != TCL_OK) { if (flags & TCL_LEAVE_ERR_MSG) { TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", - ((initialArrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), - index); + ((initialArrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index); Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", (char *)NULL); } } @@ -2615,22 +2614,22 @@ UnsetVarStruct( if ((dummyVar.flags & VAR_TRACED_UNSET) || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) { - /* - * Pass the array element name to TclObjCallVarTraces(), because - * it cannot be determined from dummyVar. Alternatively, indicate - * via flags whether the variable involved in the code that caused - * the trace to be triggered was an array element, for the correct - * formatting of error messages. - */ - if (part2Ptr) { - flags |= VAR_ARRAY_ELEMENT; - } else if (TclIsVarArrayElement(varPtr)) { - part2Ptr = VarHashGetKey(varPtr); - } + /* + * Pass the array element name to TclObjCallVarTraces(), because + * it cannot be determined from dummyVar. Alternatively, indicate + * via flags whether the variable involved in the code that caused + * the trace to be triggered was an array element, for the correct + * formatting of error messages. + */ + if (part2Ptr) { + flags |= VAR_ARRAY_ELEMENT; + } else if (TclIsVarArrayElement(varPtr)) { + part2Ptr = VarHashGetKey(varPtr); + } dummyVar.flags &= ~VAR_TRACE_ACTIVE; TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr, - (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT)) + (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|VAR_ARRAY_ELEMENT)) | TCL_TRACE_UNSETS, /* leaveErrMsg */ 0, index); @@ -2814,7 +2813,7 @@ Tcl_AppendObjCmd( } if (objc == 2) { - varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); + varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG); if (varValuePtr == NULL) { return TCL_ERROR; } @@ -4302,7 +4301,7 @@ ArrayUnsetCmd( Tcl_Obj *varNameObj, *patternObj, *nameObj; Tcl_HashSearch search; const char *pattern; - int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */ + int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */ int isArray; switch (objc) { @@ -4481,7 +4480,7 @@ ObjMakeUpvar( * NULL means use global :: context. */ Tcl_Obj *otherP1Ptr, const char *otherP2, /* Two-part name of variable in framePtr. */ - int otherFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: + int otherFlags, /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of "other" variable. */ Tcl_Obj *myNamePtr, /* Name of variable which will refer to * otherP1/otherP2. Must be a scalar. */ @@ -4527,8 +4526,8 @@ ObjMakeUpvar( if (index < 0) { if (!(arrayPtr != NULL - ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) - : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr))) + ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) + : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr))) && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) || (varFramePtr == NULL) || !HasLocalVars(varFramePtr) @@ -5338,7 +5337,7 @@ ParseSearchId( static void DeleteSearches( Interp *iPtr, - Var *arrayVarPtr) /* Variable whose searches are to be + Var *arrayVarPtr) /* Variable whose searches are to be * deleted. */ { ArraySearch *searchPtr, *nextPtr; @@ -5611,7 +5610,7 @@ DeleteArray( elPtr->flags &= ~VAR_TRACE_ACTIVE; TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr, - elNamePtr, flags, /* leaveErrMsg */ 0, index); + elNamePtr, flags,/* leaveErrMsg */ 0, index); } tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr); tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr); @@ -6807,7 +6806,7 @@ FreeVarEntry( static int CompareVarKeys( - void *keyPtr, /* New key to compare. */ + void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; @@ -7087,13 +7086,13 @@ SetArrayDefault( */ if (tablePtr->defaultObj) { - Tcl_DecrRefCount(tablePtr->defaultObj); - Tcl_DecrRefCount(tablePtr->defaultObj); + Tcl_DecrRefCount(tablePtr->defaultObj); + Tcl_DecrRefCount(tablePtr->defaultObj); } tablePtr->defaultObj = defaultObj; if (tablePtr->defaultObj) { - Tcl_IncrRefCount(tablePtr->defaultObj); - Tcl_IncrRefCount(tablePtr->defaultObj); + Tcl_IncrRefCount(tablePtr->defaultObj); + Tcl_IncrRefCount(tablePtr->defaultObj); } } diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 679934f..b0bb383 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -45,7 +45,7 @@ * Macros to report errors only if an interp is present. */ -#define ZIPFS_ERROR(interp, errstr) \ +#define ZIPFS_ERROR(interp,errstr) \ do { \ if (interp) { \ Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); \ @@ -59,14 +59,14 @@ Tcl_SetErrorCode(interp, "TCL", "MALLOC", (char *)NULL); \ } \ } while (0) -#define ZIPFS_POSIX_ERROR(interp, errstr) \ +#define ZIPFS_POSIX_ERROR(interp,errstr) \ do { \ if (interp) { \ Tcl_SetObjResult(interp, Tcl_ObjPrintf( \ "%s: %s", errstr, Tcl_PosixError(interp))); \ } \ } while (0) -#define ZIPFS_ERROR_CODE(interp, errcode) \ +#define ZIPFS_ERROR_CODE(interp,errcode) \ do { \ if (interp) { \ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", errcode, (char *)NULL); \ @@ -196,7 +196,7 @@ typedef struct ZipFile { size_t baseOffset; /* Archive start */ size_t passOffset; /* Password start */ size_t directoryOffset; /* Archive directory start */ - size_t directorySize; /* Size of archive directory */ + size_t directorySize; /* Size of archive directory */ unsigned char passBuf[264]; /* Password buffer */ size_t numOpen; /* Number of open files on archive */ struct ZipEntry *entries; /* List of files in archive */ @@ -258,10 +258,10 @@ typedef struct ZipChannel { Tcl_Size cursor; /* Seek position for next read or write*/ unsigned char *ubuf; /* Pointer to the uncompressed data */ unsigned char *ubufToFree; /* NULL if ubuf points to memory that does not - * need freeing. Else memory to free (ubuf - * may point *inside* the block) */ + need freeing. Else memory to free (ubuf + may point *inside* the block) */ Tcl_Size ubufSize; /* Size of allocated ubufToFree */ - int isCompressed; /* True if data is compressed */ + int iscompr; /* True if data is compressed */ int isDirectory; /* Set to 1 if directory, or -1 if root */ int isEncrypted; /* True if data is encrypted */ int mode; /* O_WRITE, O_APPEND, O_TRUNC etc.*/ @@ -1393,9 +1393,9 @@ ZipFSCloseArchive( * into the given "interp" if it is not NULL. * * Side effects: - * The given ZipFile struct is filled with information about the ZIP - * archive file. On error, ZipFSCloseArchive is called on zf but - * it is not freed. + * The given ZipFile struct is filled with information about the ZIP + * archive file. On error, ZipFSCloseArchive is called on zf but + * it is not freed. * *------------------------------------------------------------------------- */ @@ -1594,7 +1594,7 @@ ZipFSFindTOC( * Results: * TCL_OK on success, TCL_ERROR otherwise with an error message placed * into the given "interp" if it is not NULL. On error, ZipFSCloseArchive - * is called on zf but it is not freed. + * is called on zf but it is not freed. * * Side effects: * ZIP archive is memory mapped or read into allocated memory, the given @@ -1660,7 +1660,7 @@ ZipFSOpenArchive( ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } - /* What's the magic about 64 * 1024 * 1024 ? */ + /* What's the magic about 64 * 1024 * 1024 ? */ if ((zf->length <= ZIP_CENTRAL_END_LEN) || (zf->length - ZIP_CENTRAL_END_LEN) > (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) { @@ -2230,8 +2230,7 @@ ListMountPoints( *------------------------------------------------------------------------ */ static void -CleanupMount( - ZipFile *zf) /* Mount point */ +CleanupMount(ZipFile *zf) /* Mount point */ { ZipEntry *z, *znext; Tcl_HashEntry *hPtr; @@ -3280,7 +3279,7 @@ ComputeNameInArchive( * archive */ const char *strip, /* A prefix to strip; may be NULL if no * stripping need be done. */ - Tcl_Size slen) /* The length of the prefix; must be 0 if no + Tcl_Size slen) /* The length of the prefix; must be 0 if no * stripping need be done. */ { const char *name; @@ -5116,7 +5115,7 @@ InitReadableChannel( unsigned char *ubuf = NULL; int ch; - info->isCompressed = (z->compressMethod == ZIP_COMPMETH_DEFLATED); + info->iscompr = (z->compressMethod == ZIP_COMPMETH_DEFLATED); info->ubuf = z->zipFilePtr->data + z->offset; info->ubufToFree = NULL; /* ubuf memory not allocated */ info->ubufSize = 0; @@ -5136,7 +5135,7 @@ InitReadableChannel( info->ubuf += ZIP_CRYPT_HDR_LEN; } - if (info->isCompressed) { + if (info->iscompr) { z_stream stream; int err; unsigned int j; @@ -5547,8 +5546,8 @@ ZipFSMatchInDirectoryProc( if ((wanted & TCL_GLOB_TYPE_MOUNT) && (wanted != TCL_GLOB_TYPE_MOUNT)) { if (interp) { ZIPFS_ERROR(interp, - "Internal error: TCL_GLOB_TYPE_MOUNT should not " - "be set in conjunction with other glob types."); + "Internal error: TCL_GLOB_TYPE_MOUNT should not " + "be set in conjunction with other glob types."); } return TCL_ERROR; } @@ -6519,7 +6518,7 @@ TclZipfs_Mount( Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(const char *), /* Path to ZIP file to mount. */ TCL_UNUSED(const char *), /* Mount point path. */ - TCL_UNUSED(const char *)) /* Password for opening the ZIP, or NULL if + TCL_UNUSED(const char *)) /* Password for opening the ZIP, or NULL if * the ZIP is unprotected. */ { ZIPFS_ERROR(interp, "no zlib available"); @@ -6556,7 +6555,7 @@ TclZipfs_AppHook( #ifdef _WIN32 TCL_UNUSED(WCHAR ***)) /* argvPtr */ #else /* !_WIN32 */ - TCL_UNUSED(char ***)) /* Pointer to argv */ + TCL_UNUSED(char ***)) /* Pointer to argv */ #endif /* _WIN32 */ { return NULL; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index dfaf7331e..595ddf4 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -3786,7 +3786,7 @@ ZlibStackChannelTransform( } switch (format) { - case TCL_ZLIB_FORMAT_RAW: + case TCL_ZLIB_FORMAT_RAW: wbits = WBITS_RAW; break; case TCL_ZLIB_FORMAT_ZLIB: diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 24c0d20..15b4fcd 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -84,11 +84,11 @@ static int SetOSTypeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfOSType(Tcl_Obj *objPtr); static const Tcl_ObjType tclOSTypeType = { - "osType", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - UpdateStringOfOSType, /* updateStringProc */ - SetOSTypeFromAny, /* setFromAnyProc */ + "osType", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + UpdateStringOfOSType, /* updateStringProc */ + SetOSTypeFromAny, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; @@ -691,7 +691,7 @@ SetOSTypeFromAny( static void UpdateStringOfOSType( - Tcl_Obj *objPtr) /* OSType object whose string rep to + Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { const size_t size = TCL_UTF_MAX * 4; diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index 48bac84..d8af241 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -311,7 +311,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -999,7 +999,7 @@ TclpAlertNotifier( void TclpSetTimer( - const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ + const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { ThreadSpecificData *tsdPtr; CFRunLoopTimerRef runLoopTimer; @@ -1113,7 +1113,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -1907,7 +1907,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(void *), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index fd9d752..6158c99 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -29,7 +29,7 @@ extern Tcl_LibraryInitProc Tcltest_SafeInit; #endif /* TCL_TEST */ #ifdef TCL_XT_TEST -extern void XtToolkitInitialize(void); +extern void XtToolkitInitialize(void); extern Tcl_LibraryInitProc Tclxttest_Init; #endif /* TCL_XT_TEST */ diff --git a/unix/tclEpollNotfy.c b/unix/tclEpollNotfy.c index 76377d3..2a1733a 100644 --- a/unix/tclEpollNotfy.c +++ b/unix/tclEpollNotfy.c @@ -42,7 +42,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -207,10 +207,10 @@ PlatformEventsControl( newEvent.events |= EPOLLOUT; } if (isNew) { - newPedPtr = (struct PlatformEventData *) + newPedPtr = (struct PlatformEventData *) Tcl_Alloc(sizeof(struct PlatformEventData)); - newPedPtr->filePtr = filePtr; - newPedPtr->tsdPtr = tsdPtr; + newPedPtr->filePtr = filePtr; + newPedPtr->tsdPtr = tsdPtr; filePtr->pedPtr = newPedPtr; } newEvent.data.ptr = filePtr->pedPtr; @@ -227,22 +227,23 @@ PlatformEventsControl( } if (epoll_ctl(tsdPtr->eventsFd, op, filePtr->fd, &newEvent) == -1) { - switch (errno) { - case EPERM: - switch (op) { - case EPOLL_CTL_ADD: - if (isNew) { - LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, - filePtr, readyNode); + switch (errno) { + case EPERM: + switch (op) { + case EPOLL_CTL_ADD: + if (isNew) { + LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr, + readyNode); + } + break; + case EPOLL_CTL_DEL: + LIST_REMOVE(filePtr, readyNode); + break; + } break; - case EPOLL_CTL_DEL: - LIST_REMOVE(filePtr, readyNode); - break; - } - break; - default: - Tcl_Panic("epoll_ctl: %s", strerror(errno)); + default: + Tcl_Panic("epoll_ctl: %s", strerror(errno)); } } return; @@ -366,7 +367,7 @@ PlatformEventsInit(void) filePtr->mask = TCL_READABLE; PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1); if (!tsdPtr->readyEvents) { - tsdPtr->maxReadyEvents = 512; + tsdPtr->maxReadyEvents = 512; tsdPtr->readyEvents = (struct epoll_event *) Tcl_Alloc( tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0])); } @@ -512,7 +513,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -790,7 +791,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - void *clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index b58ab41..ba49842 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -40,7 +40,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -517,7 +517,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -786,7 +786,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - void *clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index e0d8c53..54290ec 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -148,7 +148,7 @@ TclpDlopen( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Obj *pathPtr, /* Name of the file containing the desired * code (UTF-8). */ - Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded + Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, @@ -548,7 +548,7 @@ TclpLoadMemory( int codeSize, /* Size of code data read into buffer or -1 if * an error occurred and the buffer should * just be freed. */ - Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded + Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ Tcl_FSUnloadFileProc **unloadProcPtr, diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index fc10162..de185fb 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -61,7 +61,7 @@ TclpDlopen( const char *native; int result = 1; - NXStream *errorStream = NXOpenMemory(0, 0, NX_READWRITE); + NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE); fileName = TclGetString(pathPtr); @@ -72,7 +72,7 @@ TclpDlopen( */ native = Tcl_FSGetNativePath(pathPtr); - files = {native, NULL}; + files = {native,NULL}; result = rld_load(errorStream, &header, files, NULL); @@ -90,7 +90,7 @@ TclpDlopen( return TCL_ERROR; } native = Tcl_DStringValue(&ds); - files = {native, NULL}; + files = {native,NULL}; result = rld_load(errorStream, &header, files, NULL); Tcl_DStringFree(&ds); } diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 9c34e73..81f314f 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -128,7 +128,7 @@ TclpDlopen( */ if ((pkg = strrchr(fileName, '/')) == NULL) { - pkg = fileName; + pkg = fileName; } else { pkg++; } diff --git a/unix/tclSelectNotfy.c b/unix/tclSelectNotfy.c index 7c74dfc..bede898 100644 --- a/unix/tclSelectNotfy.c +++ b/unix/tclSelectNotfy.c @@ -32,7 +32,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -480,7 +480,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -921,7 +921,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(void *), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index c04c4fa..3f972ae 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -30,7 +30,7 @@ # elif defined(FIORDCHK) # define GETREADQUEUE(fd, int) int = ioctl((fd), FIORDCHK, NULL) # else -# define GETREADQUEUE(fd, int) int = 0 +# define GETREADQUEUE(fd, int) int = 0 # endif # ifdef TIOCOUTQ @@ -162,10 +162,10 @@ static int TtySetOptionProc(void *instanceData, static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ - NULL, + NULL, NULL, /* Set option proc. */ FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ @@ -188,7 +188,7 @@ static const Tcl_ChannelType fileChannelType = { static const Tcl_ChannelType ttyChannelType = { "tty", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -196,7 +196,7 @@ static const Tcl_ChannelType ttyChannelType = { TtyGetOptionProc, /* Get option proc. */ FileWatchProc, /* Initialize notifier. */ FileGetHandleProc, /* Get OS handles out of channel. */ - TtyCloseProc, /* New-style close proc. */ + TtyCloseProc, /* close2proc. */ FileBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ @@ -225,7 +225,7 @@ static const Tcl_ChannelType ttyChannelType = { static int FileBlockModeProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ int mode) /* The mode to set. Can be TCL_MODE_BLOCKING * or TCL_MODE_NONBLOCKING. */ { @@ -258,7 +258,7 @@ FileBlockModeProc( static int FileInputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ char *buf, /* Where to store data read. */ int toRead, /* How much space is available in the * buffer? */ @@ -308,7 +308,7 @@ FileInputProc( static int FileOutputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ @@ -355,7 +355,7 @@ FileOutputProc( static int FileCloseProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -448,7 +448,7 @@ TtyCloseProc( static long long FileWideSeekProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? Can be * one of SEEK_START, SEEK_CUR or SEEK_END. */ @@ -496,7 +496,7 @@ FileWatchNotifyChannelWrapper( static void FileWatchProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -536,9 +536,9 @@ FileWatchProc( static int FileGetHandleProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { FileState *fsPtr = (FileState *)instanceData; @@ -773,7 +773,7 @@ TtyModemStatusStr( static int TtySetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ @@ -1113,7 +1113,7 @@ TtySetOptionProc( static int TtyGetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ @@ -1654,11 +1654,11 @@ TtyParseMode( if ( #if defined(PAREXT) - strchr("noems", parity) + strchr("noems", parity) #else - strchr("noe", parity) + strchr("noe", parity) #endif /* PAREXT */ - == NULL) { + == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s parity: should be %s", bad, @@ -2069,7 +2069,7 @@ Tcl_GetOpenFile( * Ignored, we always check that * the channel is open for the requested * mode. */ - void **filePtr) /* Store pointer to FILE structure here. */ + void **filePtr) /* Store pointer to FILE structure here. */ { Tcl_Channel chan; int chanMode, fd; diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 8b6a421..30ddb71 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -164,14 +164,14 @@ TclUnixSetBlockingMode( * * TclpGetPwNam -- * - * Thread-safe wrappers for getpwnam(). See "man getpwnam" for more - * details. + * Thread-safe wrappers for getpwnam(). See "man getpwnam" for more + * details. * * Results: - * Pointer to struct passwd on success or NULL on error. + * Pointer to struct passwd on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -244,14 +244,14 @@ TclpGetPwNam( * * TclpGetPwUid -- * - * Thread-safe wrappers for getpwuid(). See "man getpwuid" for more - * details. + * Thread-safe wrappers for getpwuid(). See "man getpwuid" for more + * details. * * Results: - * Pointer to struct passwd on success or NULL on error. + * Pointer to struct passwd on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -347,14 +347,14 @@ FreePwBuf( * * TclpGetGrNam -- * - * Thread-safe wrappers for getgrnam(). See "man getgrnam" for more - * details. + * Thread-safe wrappers for getgrnam(). See "man getgrnam" for more + * details. * * Results: - * Pointer to struct group on success or NULL on error. + * Pointer to struct group on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -427,14 +427,14 @@ TclpGetGrNam( * * TclpGetGrGid -- * - * Thread-safe wrappers for getgrgid(). See "man getgrgid" for more - * details. + * Thread-safe wrappers for getgrgid(). See "man getgrgid" for more + * details. * * Results: - * Pointer to struct group on success or NULL on error. + * Pointer to struct group on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -530,14 +530,14 @@ FreeGrBuf( * * TclpGetHostByName -- * - * Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for - * more details. + * Thread-safe wrappers for gethostbyname(). See "man gethostbyname" for + * more details. * * Results: - * Pointer to struct hostent on success or NULL on error. + * Pointer to struct hostent on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -598,14 +598,14 @@ TclpGetHostByName( * * TclpGetHostByAddr -- * - * Thread-safe wrappers for gethostbyaddr(). See "man gethostbyaddr" for - * more details. + * Thread-safe wrappers for gethostbyaddr(). See "man gethostbyaddr" for + * more details. * * Results: - * Pointer to struct hostent on success or NULL on error. + * Pointer to struct hostent on success or NULL on error. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -661,14 +661,14 @@ TclpGetHostByAddr( * * CopyGrp -- * - * Copies string fields of the group structure to the private buffer, - * honouring the size of the buffer. + * Copies string fields of the group structure to the private buffer, + * honouring the size of the buffer. * * Results: - * 0 on success or -1 on error (errno = ERANGE). + * 0 on success or -1 on error (errno = ERANGE). * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -734,14 +734,14 @@ CopyGrp( * * CopyHostent -- * - * Copies string fields of the hostent structure to the private buffer, - * honouring the size of the buffer. + * Copies string fields of the hostent structure to the private buffer, + * honouring the size of the buffer. * * Results: - * Number of bytes copied on success or -1 on error (errno = ERANGE) + * Number of bytes copied on success or -1 on error (errno = ERANGE) * * Side effects: - * None + * None * *--------------------------------------------------------------------------- */ @@ -796,15 +796,15 @@ CopyHostent( * * CopyPwd -- * - * Copies string fields of the passwd structure to the private buffer, - * honouring the size of the buffer. + * Copies string fields of the passwd structure to the private buffer, + * honouring the size of the buffer. * * Results: - * 0 on success or -1 on error (errno = ERANGE). + * 0 on success or -1 on error (errno = ERANGE). * * Side effects: - * We are not copying the gecos field as it may not be supported on all - * platforms. + * We are not copying the gecos field as it may not be supported on all + * platforms. * *--------------------------------------------------------------------------- */ @@ -862,14 +862,14 @@ CopyPwd( * * CopyArray -- * - * Copies array of NULL-terminated or fixed-length strings to the private - * buffer, honouring the size of the buffer. + * Copies array of NULL-terminated or fixed-length strings to the private + * buffer, honouring the size of the buffer. * * Results: - * Number of bytes copied on success or -1 on error (errno = ERANGE) + * Number of bytes copied on success or -1 on error (errno = ERANGE) * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -926,14 +926,14 @@ CopyArray( * * CopyString -- * - * Copies a NULL-terminated string to the private buffer, honouring the - * size of the buffer + * Copies a NULL-terminated string to the private buffer, honouring the + * size of the buffer * * Results: - * 0 success or -1 on error (errno = ERANGE) + * 0 success or -1 on error (errno = ERANGE) * * Side effects: - * None + * None * *--------------------------------------------------------------------------- */ @@ -986,27 +986,25 @@ CopyString( int TclWinCPUID( - int index, /* Which CPUID value to retrieve. */ - int *regsPtr) /* Registers after the CPUID. */ + int index, /* Which CPUID value to retrieve. */ + int *regsPtr) /* Registers after the CPUID. */ { int status = TCL_ERROR; /* See: */ #if defined(__x86_64__) || defined(_M_AMD64) || defined (_M_X64) - __asm__ __volatile__( - "movq %%rbx, %%rsi \n\t" /* save %rbx */ - "cpuid \n\t" - "xchgq %%rsi, %%rbx \n\t" /* restore the old %rbx */ - : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) - : "a"(index)); + __asm__ __volatile__("movq %%rbx, %%rsi \n\t" /* save %rbx */ + "cpuid \n\t" + "xchgq %%rsi, %%rbx \n\t" /* restore the old %rbx */ + : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) + : "a"(index)); status = TCL_OK; #elif defined(__i386__) || defined(_M_IX86) - __asm__ __volatile__( - "mov %%ebx, %%esi \n\t" /* save %ebx */ - "cpuid \n\t" - "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */ - : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) - : "a"(index)); + __asm__ __volatile__("mov %%ebx, %%esi \n\t" /* save %ebx */ + "cpuid \n\t" + "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */ + : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) + : "a"(index)); status = TCL_OK; #else (void)index; diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index b9348aa..b65cdb1 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -14,7 +14,7 @@ * following copyright notice: * * Copyright © 1988, 1993, 1994 - * The Regents of the University of California. All rights reserved. + * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: @@ -757,7 +757,7 @@ TclpObjCopyDirectory( int ret; Tcl_Obj *transPtr; - transPtr = Tcl_FSGetTranslatedPath(NULL, srcPathPtr); + transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); ret = Tcl_UtfToExternalDStringEx(NULL, NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, 0, &srcString, NULL); @@ -767,7 +767,7 @@ TclpObjCopyDirectory( if (ret != TCL_OK) { *errorPtr = srcPathPtr; } else { - transPtr = Tcl_FSGetTranslatedPath(NULL, destPathPtr); + transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); ret = Tcl_UtfToExternalDStringEx(NULL, NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, TCL_ENCODING_PROFILE_TCL8, &dstString, NULL); @@ -1292,7 +1292,7 @@ TraversalDelete( static int CopyFileAtts( #ifdef MAC_OSX_TCL - const char *src, /* Path name of source file (native). */ + const char *src, /* Path name of source file (native). */ #else TCL_UNUSED(const char *) /*src*/, #endif @@ -1766,14 +1766,14 @@ TclpObjListVolumes(void) static int GetModeFromPermString( TCL_UNUSED(Tcl_Interp *), - const char *modeStringPtr, /* Permissions string */ + const char *modeStringPtr, /* Permissions string */ mode_t *modePtr) /* pointer to the mode value */ { mode_t newMode; mode_t oldMode; /* Storage for the value of the old mode (that * is passed in), to allow for the chmod style * manipulation. */ - int i, n, who, op, what, op_found, who_found; + int i,n, who, op, what, op_found, who_found; /* * We start off checking for an "rwxrwxrwx" style permissions string @@ -2075,7 +2075,7 @@ TclpObjNormalizePath( return 0; } - if (Tcl_UtfToExternalDStringEx(interp, NULL, path, nextCheckpoint, 0, &ds, NULL)) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, path,nextCheckpoint, 0, &ds, NULL)) { Tcl_DStringFree(&ds); return -1; } @@ -2488,10 +2488,10 @@ GetUnixFileAttributes( static int SetUnixFileAttributes( - Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file (UTF-8). */ - Tcl_Obj *attributePtr) /* The attribute to set. */ + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr) /* The attribute to set. */ { int yesNo, fileAttributes, old; WCHAR *winPath; diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 95a0d9e..444c73f 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -155,11 +155,9 @@ TclpFindExecutable( #endif { encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDStringEx(NULL, encoding, name, TCL_INDEX_NONE, - TCL_ENCODING_PROFILE_TCL8, &utfName, NULL); + Tcl_ExternalToUtfDStringEx(NULL, encoding, name, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &utfName, NULL); TclSetObjNameOfExecutable( - Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), - encoding); + Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); Tcl_DStringFree(&utfName); goto done; } @@ -194,11 +192,10 @@ TclpFindExecutable( Tcl_DStringFree(&nameString); encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDStringEx(NULL, encoding, Tcl_DStringValue(&buffer), - TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &utfName, NULL); + Tcl_ExternalToUtfDStringEx(NULL, encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE, + TCL_ENCODING_PROFILE_TCL8, &utfName, NULL); TclSetObjNameOfExecutable( - Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), - encoding); + Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding); Tcl_DStringFree(&utfName); done: @@ -311,8 +308,7 @@ TclpMatchInDirectory( * Now open the directory for reading and iterate over the contents. */ - if (Tcl_UtfToExternalDStringEx(interp, NULL, dirName, TCL_INDEX_NONE, - 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, dirName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { Tcl_DStringFree(&dsOrig); Tcl_DStringFree(&ds); Tcl_DecrRefCount(fileNamePtr); @@ -328,7 +324,7 @@ TclpMatchInDirectory( return TCL_OK; } - d = TclOSopendir(native); /* INTL: Native. */ + d = TclOSopendir(native); /* INTL: Native. */ if (d == NULL) { Tcl_DStringFree(&ds); if (interp != NULL) { @@ -382,8 +378,8 @@ TclpMatchInDirectory( * and pattern. If so, add the file to the result. */ - if (Tcl_ExternalToUtfDStringEx(interp, NULL, entryPtr->d_name, - TCL_INDEX_NONE, 0, &utfDs, NULL) != TCL_OK) { + if (Tcl_ExternalToUtfDStringEx(interp, NULL, entryPtr->d_name, TCL_INDEX_NONE, + 0, &utfDs, NULL) != TCL_OK) { matchResult = -1; break; } @@ -393,8 +389,7 @@ TclpMatchInDirectory( if (types != NULL) { Tcl_DStringSetLength(&ds, nativeDirLen); - native = Tcl_DStringAppend(&ds, entryPtr->d_name, - TCL_INDEX_NONE); + native = Tcl_DStringAppend(&ds, entryPtr->d_name, TCL_INDEX_NONE); matchResult = NativeMatchType(interp, native, entryPtr->d_name, types); typeOk = (matchResult == 1); @@ -443,10 +438,10 @@ TclpMatchInDirectory( static int NativeMatchType( - Tcl_Interp *interp, /* Interpreter to receive errors. */ - const char *nativeEntry, /* Native path to check. */ - const char *nativeName, /* Native filename to check. */ - Tcl_GlobTypeData *types) /* Type description to match against. */ + Tcl_Interp *interp, /* Interpreter to receive errors. */ + const char *nativeEntry, /* Native path to check. */ + const char *nativeName, /* Native filename to check. */ + Tcl_GlobTypeData *types) /* Type description to match against. */ { Tcl_StatBuf buf; @@ -616,8 +611,7 @@ TclpGetUserHome( Tcl_DString ds; const char *native; - if (Tcl_UtfToExternalDStringEx(NULL, NULL, name, TCL_INDEX_NONE, 0, &ds, - NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(NULL, NULL, name, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { Tcl_DStringFree(&ds); return NULL; } @@ -629,8 +623,7 @@ TclpGetUserHome( if (pwPtr == NULL) { return NULL; } - if (Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_dir, TCL_INDEX_NONE, - 0, bufferPtr, NULL) != TCL_OK) { + if (Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_dir, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) { return NULL; } else { return Tcl_DStringValue(bufferPtr); @@ -812,8 +805,7 @@ TclpGetCwd( } return NULL; } - if (Tcl_ExternalToUtfDStringEx(interp, NULL, buffer, TCL_INDEX_NONE, 0, - bufferPtr, NULL) != TCL_OK) { + if (Tcl_ExternalToUtfDStringEx(interp, NULL, buffer, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) { return NULL; } return Tcl_DStringValue(bufferPtr); @@ -851,8 +843,7 @@ TclpReadlink( const char *native; Tcl_DString ds; - if (Tcl_UtfToExternalDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, &ds, - NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { Tcl_DStringFree(&ds); return NULL; } @@ -864,8 +855,7 @@ TclpReadlink( return NULL; } - if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, length, 0, linkPtr, - NULL) == TCL_OK) { + if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, length, 0, linkPtr, NULL) == TCL_OK) { return Tcl_DStringValue(linkPtr); } #endif /* !DJGPP */ @@ -1000,8 +990,7 @@ TclpObjLink( return NULL; } target = TclGetStringFromObj(transPtr, &length); - if (Tcl_UtfToExternalDStringEx(NULL, NULL, target, length, 0, &ds, - NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(NULL, NULL, target, length, 0, &ds, NULL) != TCL_OK) { Tcl_DStringFree(&ds); return NULL; } @@ -1035,14 +1024,12 @@ TclpObjLink( } Tcl_DecrRefCount(transPtr); - length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, - sizeof(link)); + length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link)); if (length < 0) { return NULL; } - if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, 0, - &ds, NULL) != TCL_OK) { + if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, 0, &ds, NULL) != TCL_OK) { return NULL; } linkPtr = Tcl_DStringToObj(&ds); @@ -1109,8 +1096,7 @@ TclpNativeToNormalized( { Tcl_DString ds; - Tcl_ExternalToUtfDStringEx(NULL, NULL, (const char *) clientData, - TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); + Tcl_ExternalToUtfDStringEx(NULL, NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); return Tcl_DStringToObj(&ds); } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index ac743cc..81e3af5 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -54,21 +54,21 @@ static const char *const processors[NUMPROCESSORS] = { typedef struct { union { - unsigned int dwOemId; - struct { - int wProcessorArchitecture; - int wReserved; - }; + unsigned int dwOemId; + struct { + int wProcessorArchitecture; + int wReserved; + }; }; - unsigned int dwPageSize; + unsigned int dwPageSize; void *lpMinimumApplicationAddress; void *lpMaximumApplicationAddress; void *dwActiveProcessorMask; - unsigned int dwNumberOfProcessors; - unsigned int dwProcessorType; - unsigned int dwAllocationGranularity; - int wProcessorLevel; - int wProcessorRevision; + unsigned int dwNumberOfProcessors; + unsigned int dwProcessorType; + unsigned int dwAllocationGranularity; + int wProcessorLevel; + int wProcessorRevision; } SYSTEM_INFO; typedef struct { @@ -852,25 +852,23 @@ TclpSetVariables( #endif /* HAVE_COREFOUNDATION */ p = pkgPath; while ((q = strchr(p, ':')) != NULL) { - Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q - p)); - p = q + 1; + Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q-p)); + p = q+1; } if (*p) { Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, -1)); } - Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_pkgPath", -1), NULL, - pkgListObj, TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_pkgPath", -1), NULL, pkgListObj, TCL_GLOBAL_ONLY); { - /* Some platforms build configure scripts expect ~ expansion so do that */ - Tcl_Obj *origPaths; - Tcl_Obj *resolvedPaths; - - origPaths = Tcl_GetVar2Ex(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); - resolvedPaths = TclResolveTildePathList(origPaths); - if (resolvedPaths != origPaths && resolvedPaths != NULL) { - Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, resolvedPaths, - TCL_GLOBAL_ONLY); - } + /* Some platforms build configure scripts expect ~ expansion so do that */ + Tcl_Obj *origPaths; + Tcl_Obj *resolvedPaths; + + origPaths = Tcl_GetVar2Ex(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); + resolvedPaths = TclResolveTildePathList(origPaths); + if (resolvedPaths != origPaths && resolvedPaths != NULL) { + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, resolvedPaths, TCL_GLOBAL_ONLY); + } } #ifdef DJGPP @@ -899,8 +897,7 @@ TclpSetVariables( osInfo.dwMajorVersion = 11; } Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY); - snprintf(buffer, sizeof(buffer), "%d.%d", - osInfo.dwMajorVersion, osInfo.dwMinorVersion); + snprintf(buffer, sizeof(buffer), "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) { Tcl_SetVar2(interp, "tcl_platform", "machine", @@ -990,7 +987,7 @@ TclpSetVariables( * Define what the platform PATH separator is. [TIP #315] */ - Tcl_SetVar2(interp, "tcl_platform", "pathSeparator", ":", TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ":", TCL_GLOBAL_ONLY); } /* diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index e0b8753..939ec85 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -80,7 +80,7 @@ static int SetupStdFile(TclFile file, int type); static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -356,7 +356,7 @@ TclpCreatePipe( int TclpCloseFile( - TclFile file) /* The file to close. */ + TclFile file) /* The file to close. */ { int fd = GetFd(file); @@ -401,7 +401,7 @@ TclpCreateProcess( * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ - size_t argc, /* Number of arguments in following array. */ + size_t argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings in UTF-8. * argv[0] contains the name of the executable * translated using Tcl_TranslateFileName @@ -572,7 +572,7 @@ TclpCreateProcess( || !SetupStdFile(outputFile, TCL_STDOUT) || (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR)) || (joinThisError && - ((dup2(1, 2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) { + ((dup2(1,2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) { snprintf(errSpace, sizeof(errSpace), "%dforked process couldn't set up input/output", errno); len = strlen(errSpace); @@ -1003,7 +1003,7 @@ TclGetAndDetachPids( static int PipeBlockModeProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ @@ -1043,7 +1043,7 @@ PipeBlockModeProc( static int PipeClose2Proc( - void *instanceData, /* The pipe to close. */ + void *instanceData, /* The pipe to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { @@ -1140,7 +1140,7 @@ PipeClose2Proc( static int PipeInputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int toRead, /* How much space is available in the * buffer? */ @@ -1191,7 +1191,7 @@ PipeInputProc( static int PipeOutputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ @@ -1250,7 +1250,7 @@ PipeWatchNotifyChannelWrapper( static void PipeWatchProc( - void *instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1298,9 +1298,9 @@ PipeWatchProc( static int PipeGetHandleProc( - void *instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { PipeState *psPtr = (PipeState *)instanceData; diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 94af19b..513ffdd 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -236,7 +236,7 @@ MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode); #ifndef WIFSIGNALED # define WIFSIGNALED(stat) \ - (((*((int *) &(stat)))) && ((*((int *) &(stat))) \ + (((*((int *) &(stat)))) && ((*((int *) &(stat))) \ == ((*((int *) &(stat))) & 0x00FF))) #endif diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 14be638..78ed008 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -23,8 +23,8 @@ #define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ -#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1) -#define SOCK_TEMPLATE "sock%" TCL_Z_MODIFIER "x" +#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1) +#define SOCK_TEMPLATE "sock%" TCL_Z_MODIFIER "x" #undef SOCKET /* Possible conflict with win32 SOCKET */ @@ -64,8 +64,8 @@ struct TcpState { */ Tcl_TcpAcceptProc *acceptProc; - /* Proc to call on accept. */ - void *acceptProcData; /* The data for the accept proc. */ + /* Proc to call on accept. */ + void *acceptProcData; /* The data for the accept proc. */ /* * Only needed for client sockets @@ -75,10 +75,10 @@ struct TcpState { struct addrinfo *addr; /* Iterator over addrlist. */ struct addrinfo *myaddrlist;/* Local address. */ struct addrinfo *myaddr; /* Iterator over myaddrlist. */ - int filehandlers; /* Caches FileHandlers that get set up while - * an async socket is not yet connected. */ - int connectError; /* Cache SO_ERROR of async socket. */ - int cachedBlocking; /* Cache blocking mode of async socket. */ + int filehandlers; /* Caches FileHandlers that get set up while + * an async socket is not yet connected. */ + int connectError; /* Cache SO_ERROR of async socket. */ + int cachedBlocking; /* Cache blocking mode of async socket. */ }; /* @@ -156,7 +156,7 @@ static Tcl_FileProc WrapNotify; static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -195,7 +195,7 @@ printaddrinfo( getnameinfo(ai->ai_addr, ai->ai_addrlen, host, sizeof(host), port, sizeof(port), NI_NUMERICHOST|NI_NUMERICSERV); - fprintf(stderr, "%s: %s:%s\n", prefix, host, port); + fprintf(stderr,"%s: %s:%s\n", prefix, host, port); } } #endif @@ -227,7 +227,7 @@ InitializeHostName( memset(&u, (int) 0, sizeof(struct utsname)); if (uname(&u) >= 0) { /* INTL: Native. */ - hp = TclpGetHostByName(u.nodename); /* INTL: Native. */ + hp = TclpGetHostByName(u.nodename); /* INTL: Native. */ if (hp == NULL) { /* * Sometimes the nodename is fully qualified, but gets truncated @@ -246,11 +246,11 @@ InitializeHostName( Tcl_Free(node); } } - if (hp != NULL) { + if (hp != NULL) { native = hp->h_name; - } else { + } else { native = u.nodename; - } + } } #else /* !NO_UNAME */ /* @@ -357,7 +357,7 @@ TclpFinalizeSockets(void) static int TcpBlockModeProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ @@ -370,8 +370,8 @@ TcpBlockModeProc( SET_BITS(statePtr->flags, TCP_NONBLOCKING); } if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { - statePtr->cachedBlocking = mode; - return 0; + statePtr->cachedBlocking = mode; + return 0; } if (TclUnixSetBlockingMode(statePtr->fds.fd, mode) < 0) { return errno; @@ -443,37 +443,37 @@ WaitForConnect( */ if (GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE) - && !(errorCodePtr != NULL - && !GOT_BITS(statePtr->flags, TCP_NONBLOCKING))) { + && !(errorCodePtr != NULL + && !GOT_BITS(statePtr->flags, TCP_NONBLOCKING))) { *errorCodePtr = EWOULDBLOCK; return -1; } if (errorCodePtr == NULL || GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { - timeout = 0; + timeout = 0; } else { - timeout = -1; + timeout = -1; } do { - if (TclUnixWaitForFile(statePtr->fds.fd, - TCL_WRITABLE | TCL_EXCEPTION, timeout) != 0) { - TcpConnect(NULL, statePtr); - } - - /* - * Do this only once in the nonblocking case and repeat it until the - * socket is final when blocking. - */ + if (TclUnixWaitForFile(statePtr->fds.fd, + TCL_WRITABLE | TCL_EXCEPTION, timeout) != 0) { + TcpConnect(NULL, statePtr); + } + + /* + * Do this only once in the nonblocking case and repeat it until the + * socket is final when blocking. + */ } while (timeout == -1 && GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)); if (errorCodePtr != NULL) { - if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { - *errorCodePtr = EAGAIN; - return -1; - } else if (statePtr->connectError != 0) { - *errorCodePtr = ENOTCONN; - return -1; - } + if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { + *errorCodePtr = EAGAIN; + return -1; + } else if (statePtr->connectError != 0) { + *errorCodePtr = ENOTCONN; + return -1; + } } return 0; } @@ -502,7 +502,7 @@ WaitForConnect( static int TcpInputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -553,7 +553,7 @@ TcpInputProc( static int TcpOutputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ @@ -594,7 +594,7 @@ TcpOutputProc( static int TcpCloseProc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ TCL_UNUSED(Tcl_Interp *)) { TcpState *statePtr = (TcpState *)instanceData; @@ -627,10 +627,10 @@ TcpCloseProc( fds = next; } if (statePtr->addrlist != NULL) { - freeaddrinfo(statePtr->addrlist); + freeaddrinfo(statePtr->addrlist); } if (statePtr->myaddrlist != NULL) { - freeaddrinfo(statePtr->myaddrlist); + freeaddrinfo(statePtr->myaddrlist); } Tcl_Free(statePtr); return errorCode; @@ -655,7 +655,7 @@ TcpCloseProc( static int TcpClose2Proc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ TCL_UNUSED(Tcl_Interp *), int flags) /* Flags that indicate which side to close. */ { @@ -706,7 +706,7 @@ IPv6AddressNeedsNumericRendering( struct in6_addr addr) { if (IN6_ARE_ADDR_EQUAL(&addr, &in6addr_any)) { - return 1; + return 1; } /* @@ -715,11 +715,11 @@ IPv6AddressNeedsNumericRendering( */ if (!IN6_IS_ADDR_V4MAPPED(&addr)) { - return 0; + return 0; } return (addr.s6_addr[12] == 0 && addr.s6_addr[13] == 0 - && addr.s6_addr[14] == 0 && addr.s6_addr[15] == 0); + && addr.s6_addr[14] == 0 && addr.s6_addr[15] == 0); } #if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))) #pragma GCC diagnostic pop @@ -738,7 +738,7 @@ TcpHostPortList( int flags = 0; getnameinfo(&addr.sa, salen, nhost, sizeof(nhost), nport, sizeof(nport), - NI_NUMERICHOST | NI_NUMERICSERV); + NI_NUMERICHOST | NI_NUMERICSERV); Tcl_DStringAppendElement(dsPtr, nhost); /* @@ -747,14 +747,14 @@ TcpHostPortList( */ if (addr.sa.sa_family == AF_INET) { - if (addr.sa4.sin_addr.s_addr == INADDR_ANY) { - flags |= NI_NUMERICHOST; - } + if (addr.sa4.sin_addr.s_addr == INADDR_ANY) { + flags |= NI_NUMERICHOST; + } #ifndef NEED_FAKE_RFC2553 } else if (addr.sa.sa_family == AF_INET6) { - if (IPv6AddressNeedsNumericRendering(addr.sa6.sin6_addr)) { - flags |= NI_NUMERICHOST; - } + if (IPv6AddressNeedsNumericRendering(addr.sa6.sin6_addr)) { + flags |= NI_NUMERICHOST; + } #endif /* NEED_FAKE_RFC2553 */ } @@ -763,22 +763,22 @@ TcpHostPortList( */ if (interp != NULL && - Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { - flags |= NI_NUMERICHOST; + Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { + flags |= NI_NUMERICHOST; } if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0, - flags) == 0) { - /* - * Reverse mapping worked. - */ + flags) == 0) { + /* + * Reverse mapping worked. + */ - Tcl_DStringAppendElement(dsPtr, host); + Tcl_DStringAppendElement(dsPtr, host); } else { - /* - * Reverse mapping failed - use the numeric rep once more. - */ + /* + * Reverse mapping failed - use the numeric rep once more. + */ - Tcl_DStringAppendElement(dsPtr, nhost); + Tcl_DStringAppendElement(dsPtr, nhost); } Tcl_DStringAppendElement(dsPtr, nport); } @@ -907,25 +907,25 @@ TcpGetOptionProc( socklen_t optlen = sizeof(int); WaitForConnect(statePtr, NULL); - if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { - /* - * Suppress errors as long as we are not done. - */ - - errno = 0; - } else if (statePtr->connectError != 0) { - errno = statePtr->connectError; - statePtr->connectError = 0; - } else { - int err; - - getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &err, - &optlen); - errno = err; - } - if (errno != 0) { + if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { + /* + * Suppress errors as long as we are not done. + */ + + errno = 0; + } else if (statePtr->connectError != 0) { + errno = statePtr->connectError; + statePtr->connectError = 0; + } else { + int err; + + getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &err, + &optlen); + errno = err; + } + if (errno != 0) { Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errno), TCL_INDEX_NONE); - } + } return TCL_OK; } @@ -934,13 +934,13 @@ TcpGetOptionProc( WaitForConnect(statePtr, NULL); Tcl_DStringAppend(dsPtr, GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT) ? "1" : "0", TCL_INDEX_NONE); - return TCL_OK; + return TCL_OK; } if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && (strncmp(optionName, "-peername", len) == 0))) { - address peername; - socklen_t size = sizeof(peername); + address peername; + socklen_t size = sizeof(peername); WaitForConnect(statePtr, NULL); if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { @@ -963,11 +963,11 @@ TcpGetOptionProc( Tcl_DStringAppendElement(dsPtr, "-peername"); Tcl_DStringStartSublist(dsPtr); } - TcpHostPortList(interp, dsPtr, peername, size); + TcpHostPortList(interp, dsPtr, peername, size); if (len) { - return TCL_OK; - } - Tcl_DStringEndSublist(dsPtr); + return TCL_OK; + } + Tcl_DStringEndSublist(dsPtr); } else { /* * getpeername failed - but if we were asked for all the options @@ -979,7 +979,7 @@ TcpGetOptionProc( if (len) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get peername: %s", + "can't get peername: %s", Tcl_PosixError(interp))); } return TCL_ERROR; @@ -1004,7 +1004,7 @@ TcpGetOptionProc( * In async connect output an empty string */ - found = 1; + found = 1; } else { for (fds = &statePtr->fds; fds != NULL; fds = fds->next) { size = sizeof(sockname); @@ -1014,16 +1014,16 @@ TcpGetOptionProc( } } } - if (found) { - if (len) { - return TCL_OK; - } - Tcl_DStringEndSublist(dsPtr); - } else { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get sockname: %s", Tcl_PosixError(interp))); - } + if (found) { + if (len) { + return TCL_OK; + } + Tcl_DStringEndSublist(dsPtr); + } else { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get sockname: %s", Tcl_PosixError(interp))); + } return TCL_ERROR; } } @@ -1070,7 +1070,7 @@ TcpGetOptionProc( if (len > 0) { return Tcl_BadChannelOption(interp, optionName, - "connecting keepalive nodelay peername sockname"); + "connecting keepalive nodelay peername sockname"); } return TCL_OK; @@ -1169,7 +1169,7 @@ WrapNotify( static void TcpWatchProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1177,23 +1177,24 @@ TcpWatchProc( TcpState *statePtr = (TcpState *)instanceData; if (statePtr->acceptProc != NULL) { - /* - * Make sure we don't mess with server sockets since they will never - * be readable or writable at the Tcl level. This keeps Tcl scripts - * from interfering with the -accept behavior (bug #3394732). - */ + /* + * Make sure we don't mess with server sockets since they will never + * be readable or writable at the Tcl level. This keeps Tcl scripts + * from interfering with the -accept behavior (bug #3394732). + */ return; } if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) { - /* - * Async sockets use a FileHandler internally while connecting, so we - * need to cache this request until the connection has succeeded. - */ + /* + * Async sockets use a FileHandler internally while connecting, so we + * need to cache this request until the connection has succeeded. + */ - statePtr->filehandlers = mask; + statePtr->filehandlers = mask; } else if (mask) { + /* * Whether it is a bug or feature or otherwise, it is a fact of life * that on at least some Linux kernels select() fails to report that a @@ -1241,9 +1242,9 @@ TcpWatchProc( static int TcpGetHandleProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { TcpState *statePtr = (TcpState *)instanceData; @@ -1265,7 +1266,7 @@ TcpGetHandleProc( static void TcpAsyncCallback( - void *clientData, /* The socket state. */ + void *clientData, /* The socket state. */ TCL_UNUSED(int) /*mask*/) { TcpConnect(NULL, (TcpState *)clientData); @@ -1279,9 +1280,9 @@ TcpAsyncCallback( * This function opens a new socket in client mode. * * Results: - * TCL_OK, if the socket was successfully connected or an asynchronous - * connection is in progress. If an error occurs, TCL_ERROR is returned - * and an error message is left in interp. + * TCL_OK, if the socket was successfully connected or an asynchronous + * connection is in progress. If an error occurs, TCL_ERROR is returned + * and an error message is left in interp. * * Side effects: * Opens a socket. @@ -1313,14 +1314,14 @@ TcpConnect( static const int reuseaddr = 1; if (async_callback) { - goto reenter; + goto reenter; } for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL; - statePtr->addr = statePtr->addr->ai_next) { - for (statePtr->myaddr = statePtr->myaddrlist; - statePtr->myaddr != NULL; - statePtr->myaddr = statePtr->myaddr->ai_next) { + statePtr->addr = statePtr->addr->ai_next) { + for (statePtr->myaddr = statePtr->myaddrlist; + statePtr->myaddr != NULL; + statePtr->myaddr = statePtr->myaddr->ai_next) { /* * No need to try combinations of local and remote addresses of * different families. @@ -1330,19 +1331,19 @@ TcpConnect( continue; } - /* - * Close the socket if it is still open from the last unsuccessful - * iteration. - */ + /* + * Close the socket if it is still open from the last unsuccessful + * iteration. + */ - if (statePtr->fds.fd >= 0) { + if (statePtr->fds.fd >= 0) { close(statePtr->fds.fd); statePtr->fds.fd = -1; - errno = 0; + errno = 0; } statePtr->fds.fd = socket(statePtr->addr->ai_family, SOCK_STREAM, - 0); + 0); if (statePtr->fds.fd < 0) { continue; } @@ -1361,28 +1362,28 @@ TcpConnect( TclSockMinimumBuffers(INT2PTR(statePtr->fds.fd), SOCKET_BUFSIZE); if (async) { - ret = TclUnixSetBlockingMode(statePtr->fds.fd, - TCL_MODE_NONBLOCKING); - if (ret < 0) { - continue; - } - } - - /* - * Must reset the error variable here, before we use it for the - * first time in this iteration. - */ - - error = 0; - - (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR, - (char *) &reuseaddr, sizeof(reuseaddr)); - ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr, - statePtr->myaddr->ai_addrlen); - if (ret < 0) { - error = errno; - continue; - } + ret = TclUnixSetBlockingMode(statePtr->fds.fd, + TCL_MODE_NONBLOCKING); + if (ret < 0) { + continue; + } + } + + /* + * Must reset the error variable here, before we use it for the + * first time in this iteration. + */ + + error = 0; + + (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR, + (char *) &reuseaddr, sizeof(reuseaddr)); + ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr, + statePtr->myaddr->ai_addrlen); + if (ret < 0) { + error = errno; + continue; + } /* * Attempt to connect. The connect may fail at present with an @@ -1392,35 +1393,35 @@ TcpConnect( */ ret = connect(statePtr->fds.fd, statePtr->addr->ai_addr, - statePtr->addr->ai_addrlen); - if (ret < 0) { - error = errno; - } + statePtr->addr->ai_addrlen); + if (ret < 0) { + error = errno; + } if (ret < 0 && errno == EINPROGRESS) { - Tcl_CreateFileHandler(statePtr->fds.fd, - TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback, - statePtr); - errno = EWOULDBLOCK; - SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); - return TCL_OK; - - reenter: - CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); - Tcl_DeleteFileHandler(statePtr->fds.fd); - - /* - * Read the error state from the socket to see if the async - * connection has succeeded or failed. As this clears the - * error condition, we cache the status in the socket state - * struct for later retrieval by [fconfigure -error]. - */ - - optlen = sizeof(int); - - getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, - (char *) &error, &optlen); - errno = error; - } + Tcl_CreateFileHandler(statePtr->fds.fd, + TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback, + statePtr); + errno = EWOULDBLOCK; + SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); + return TCL_OK; + + reenter: + CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); + Tcl_DeleteFileHandler(statePtr->fds.fd); + + /* + * Read the error state from the socket to see if the async + * connection has succeeded or failed. As this clears the + * error condition, we cache the status in the socket state + * struct for later retrieval by [fconfigure -error]. + */ + + optlen = sizeof(int); + + getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, + (char *) &error, &optlen); + errno = error; + } if (error == 0) { goto out; } @@ -1431,43 +1432,43 @@ TcpConnect( statePtr->connectError = error; CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); if (async_callback) { - /* - * An asynchonous connection has finally succeeded or failed. - */ - - TcpWatchProc(statePtr, statePtr->filehandlers); - TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking); - - if (error != 0) { - SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); - } - - /* - * We need to forward the writable event that brought us here, because - * upon reading of getsockopt(SO_ERROR), at least some OSes clear the - * writable state from the socket, and so a subsequent select() on - * behalf of a script level [fileevent] would not fire. It doesn't - * hurt that this is also called in the successful case and will save - * the event mechanism one roundtrip through select(). - */ + /* + * An asynchonous connection has finally succeeded or failed. + */ + + TcpWatchProc(statePtr, statePtr->filehandlers); + TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking); + + if (error != 0) { + SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); + } + + /* + * We need to forward the writable event that brought us here, because + * upon reading of getsockopt(SO_ERROR), at least some OSes clear the + * writable state from the socket, and so a subsequent select() on + * behalf of a script level [fileevent] would not fire. It doesn't + * hurt that this is also called in the successful case and will save + * the event mechanism one roundtrip through select(). + */ if (statePtr->cachedBlocking == TCL_MODE_NONBLOCKING) { Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE); } } if (error != 0) { - /* - * Failure for either a synchronous connection, or an async one that - * failed before it could enter background mode, e.g. because an - * invalid -myaddr was given. - */ - - if (interp != NULL) { - errno = error; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", Tcl_PosixError(interp))); - } - return TCL_ERROR; + /* + * Failure for either a synchronous connection, or an async one that + * failed before it could enter background mode, e.g. because an + * invalid -myaddr was given. + */ + + if (interp != NULL) { + errno = error; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open socket: %s", Tcl_PosixError(interp))); + } + return TCL_ERROR; } return TCL_OK; } @@ -1510,16 +1511,16 @@ Tcl_OpenTcpClient( */ if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg) - || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, - &errorMsg)) { - if (addrlist != NULL) { - freeaddrinfo(addrlist); - } - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", errorMsg)); - } - return NULL; + || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, + &errorMsg)) { + if (addrlist != NULL) { + freeaddrinfo(addrlist); + } + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open socket: %s", errorMsg)); + } + return NULL; } /* @@ -1539,14 +1540,14 @@ Tcl_OpenTcpClient( */ if (TcpConnect(interp, statePtr) != TCL_OK) { - TcpCloseProc(statePtr, NULL); - return NULL; + TcpCloseProc(statePtr, NULL); + return NULL; } snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, PTR2INT(statePtr)); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, - statePtr, TCL_READABLE | TCL_WRITABLE); + statePtr, TCL_READABLE | TCL_WRITABLE); if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation", "auto crlf") == TCL_ERROR) { Tcl_CloseEx(NULL, statePtr->channel, 0); @@ -1573,10 +1574,10 @@ Tcl_OpenTcpClient( Tcl_Channel Tcl_MakeTcpClientChannel( - void *sock) /* The socket to wrap up into a channel. */ + void *sock) /* The socket to wrap up into a channel. */ { return (Tcl_Channel) TclpMakeTcpClientChannelMode(sock, - TCL_READABLE | TCL_WRITABLE); + TCL_READABLE | TCL_WRITABLE); } /* @@ -1598,7 +1599,7 @@ Tcl_MakeTcpClientChannel( void * TclpMakeTcpClientChannelMode( - void *sock, /* The socket to wrap up into a channel. */ + void *sock, /* The socket to wrap up into a channel. */ int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { @@ -1645,7 +1646,7 @@ Tcl_OpenTcpServerEx( const char *service, /* Port number to open. */ const char *myHost, /* Name of local host. */ unsigned int flags, /* Flags. */ - int backlog, /* Length of OS listen backlog queue. */ + int backlog, /* Length of OS listen backlog queue. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ @@ -1683,17 +1684,17 @@ Tcl_OpenTcpServerEx( repeat: if (retry > 0) { - if (statePtr != NULL) { - TcpCloseProc(statePtr, NULL); - statePtr = NULL; - } - if (addrlist != NULL) { - freeaddrinfo(addrlist); - addrlist = NULL; - } - if (retry >= MAXRETRY) { - goto error; - } + if (statePtr != NULL) { + TcpCloseProc(statePtr, NULL); + statePtr = NULL; + } + if (addrlist != NULL) { + freeaddrinfo(addrlist); + addrlist = NULL; + } + if (retry >= MAXRETRY) { + goto error; + } } retry++; chosenport = 0; @@ -1704,14 +1705,14 @@ Tcl_OpenTcpServerEx( } if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, - &errorMsg)) { + &errorMsg)) { my_errno = errno; goto error; } for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) { sock = socket(addrPtr->ai_family, addrPtr->ai_socktype, - addrPtr->ai_protocol); + addrPtr->ai_protocol); if (sock == -1) { if (howfar < SOCKET) { howfar = SOCKET; @@ -1759,101 +1760,100 @@ Tcl_OpenTcpServerEx( #endif } - /* - * Make sure we use the same port number when opening two server - * sockets for IPv4 and IPv6 on a random port. - * - * As sockaddr_in6 uses the same offset and size for the port member - * as sockaddr_in, we can handle both through the IPv4 API. - */ + /* + * Make sure we use the same port number when opening two server + * sockets for IPv4 and IPv6 on a random port. + * + * As sockaddr_in6 uses the same offset and size for the port member + * as sockaddr_in, we can handle both through the IPv4 API. + */ if (port == 0 && chosenport != 0) { ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port = - htons(chosenport); + htons(chosenport); } #ifdef IPV6_V6ONLY /* - * Missing on: Solaris 2.8 - */ + * Missing on: Solaris 2.8 + */ - if (addrPtr->ai_family == AF_INET6) { - int v6only = 1; + if (addrPtr->ai_family == AF_INET6) { + int v6only = 1; - (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY, - &v6only, sizeof(v6only)); - } + (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY, + &v6only, sizeof(v6only)); + } #endif /* IPV6_V6ONLY */ status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen); - if (status == -1) { + if (status == -1) { if (howfar < BIND) { howfar = BIND; my_errno = errno; } - close(sock); - sock = -1; - if (port == 0 && errno == EADDRINUSE) { - goto repeat; - } - continue; - } - if (port == 0 && chosenport == 0) { - address sockname; - socklen_t namelen = sizeof(sockname); - - /* - * Synchronize port numbers when binding to port 0 of multiple - * addresses. - */ - - if (getsockname(sock, &sockname.sa, &namelen) >= 0) { - chosenport = ntohs(sockname.sa4.sin_port); - } - } - if (backlog < 0) { - backlog = SOMAXCONN; - } - status = listen(sock, backlog); - if (status < 0) { + close(sock); + sock = -1; + if (port == 0 && errno == EADDRINUSE) { + goto repeat; + } + continue; + } + if (port == 0 && chosenport == 0) { + address sockname; + socklen_t namelen = sizeof(sockname); + + /* + * Synchronize port numbers when binding to port 0 of multiple + * addresses. + */ + + if (getsockname(sock, &sockname.sa, &namelen) >= 0) { + chosenport = ntohs(sockname.sa4.sin_port); + } + } + if (backlog < 0) { + backlog = SOMAXCONN; + } + status = listen(sock, backlog); + if (status < 0) { if (howfar < LISTEN) { howfar = LISTEN; my_errno = errno; } - close(sock); - sock = -1; - if (port == 0 && errno == EADDRINUSE) { - goto repeat; - } - continue; - } - if (statePtr == NULL) { - /* - * Allocate a new TcpState for this socket. - */ - - statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); - memset(statePtr, 0, sizeof(TcpState)); - statePtr->acceptProc = acceptProc; - statePtr->acceptProcData = acceptProcData; - snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, - PTR2INT(statePtr)); - newfds = &statePtr->fds; - } else { - newfds = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); - memset(newfds, (int) 0, sizeof(TcpFdList)); - fds->next = newfds; - } - newfds->fd = sock; - newfds->statePtr = statePtr; - fds = newfds; - - /* - * Set up the callback mechanism for accepting connections from new - * clients. - */ - - Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds); + close(sock); + sock = -1; + if (port == 0 && errno == EADDRINUSE) { + goto repeat; + } + continue; + } + if (statePtr == NULL) { + /* + * Allocate a new TcpState for this socket. + */ + + statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); + memset(statePtr, 0, sizeof(TcpState)); + statePtr->acceptProc = acceptProc; + statePtr->acceptProcData = acceptProcData; + snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, PTR2INT(statePtr)); + newfds = &statePtr->fds; + } else { + newfds = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList)); + memset(newfds, (int) 0, sizeof(TcpFdList)); + fds->next = newfds; + } + newfds->fd = sock; + newfds->statePtr = statePtr; + fds = newfds; + + /* + * Set up the callback mechanism for accepting connections from new + * clients. + */ + + Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds); } error: @@ -1866,15 +1866,15 @@ Tcl_OpenTcpServerEx( return statePtr->channel; } if (interp != NULL) { - Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", TCL_INDEX_NONE); + Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", TCL_INDEX_NONE); if (errorMsg == NULL) { - errno = my_errno; - Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), TCL_INDEX_NONE); - } else { + errno = my_errno; + Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), TCL_INDEX_NONE); + } else { Tcl_AppendToObj(errorObj, errorMsg, TCL_INDEX_NONE); } - Tcl_SetObjResult(interp, errorObj); + Tcl_SetObjResult(interp, errorObj); } if (sock != -1) { close(sock); @@ -1900,7 +1900,7 @@ Tcl_OpenTcpServerEx( static void TcpAccept( - void *data, /* Callback token. */ + void *data, /* Callback token. */ TCL_UNUSED(int) /*mask*/) { TcpFdList *fds = (TcpFdList *)data; /* Client data of server socket. */ @@ -1938,9 +1938,9 @@ TcpAccept( if (fds->statePtr->acceptProc != NULL) { getnameinfo(&addr.sa, len, host, sizeof(host), port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); + NI_NUMERICHOST|NI_NUMERICSERV); fds->statePtr->acceptProc(fds->statePtr->acceptProcData, - newSockState->channel, host, atoi(port)); + newSockState->channel, host, atoi(port)); } } diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index da39a96..24bc72d 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -213,8 +213,8 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ - void *clientData, /* The one argument to Main() */ - size_t stackSize, /* Size of stack for the new thread */ + void *clientData, /* The one argument to Main() */ + size_t stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c index 6d4e3c9..8ca2c5f 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -33,7 +33,7 @@ typedef struct FileHandler { XtInputId except; /* Xt exception callback handle. */ Tcl_FileProc *proc; /* Procedure to call, in the style of * Tcl_CreateFileHandler. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -263,7 +263,7 @@ NotifierExitHandler( static void SetTimer( - const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ + const Tcl_Time *timePtr) /* Timeout value, may be NULL. */ { unsigned long timeout; @@ -339,7 +339,7 @@ CreateFileHandler( * called. */ Tcl_FileProc *proc, /* Procedure to call for each selected * event. */ - void *clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { FileHandler *filePtr; @@ -627,7 +627,7 @@ FileHandlerEventProc( static int WaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { int timeout; diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 1d83976..01fa6c3 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -432,8 +432,8 @@ TclWinDriveLetterForVolMountPoint( int TclWinCPUID( - int index, /* Which CPUID value to retrieve. */ - int *regsPtr) /* Registers after the CPUID. */ + int index, /* Which CPUID value to retrieve. */ + int *regsPtr) /* Registers after the CPUID. */ { int status = TCL_ERROR; diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 75beedd..4c08464 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -384,7 +384,7 @@ FileEventProc( static int FileBlockProc( - void *instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -423,7 +423,7 @@ FileBlockProc( static int FileCloseProc( - void *instanceData, /* Pointer to FileInfo structure. */ + void *instanceData, /* Pointer to FileInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -473,7 +473,7 @@ FileCloseProc( * pointer on the thread local list. */ - FileThreadActionProc(fileInfoPtr, TCL_CHANNEL_THREAD_REMOVE); + FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE); break; } } @@ -501,7 +501,7 @@ FileCloseProc( static long long FileWideSeekProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ @@ -553,7 +553,7 @@ FileWideSeekProc( static int FileTruncateProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ long long length) /* Length to truncate at. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -629,7 +629,7 @@ FileTruncateProc( static int FileInputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ char *buf, /* Where to store data read. */ int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ @@ -684,7 +684,7 @@ FileInputProc( static int FileOutputProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -731,7 +731,7 @@ FileOutputProc( static void FileWatchProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ int mask) /* What events to watch for; OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -770,9 +770,9 @@ FileWatchProc( static int FileGetHandleProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -891,8 +891,7 @@ StatOpenFile( */ TclNewObj(dictObj); -#define STORE_ELEM(name, value) \ - StoreElementInDict(dictObj, name, value) +#define STORE_ELEM(name, value) StoreElementInDict(dictObj, name, value) STORE_ELEM("dev", Tcl_NewWideIntObj((long) dev)); STORE_ELEM("ino", Tcl_NewWideIntObj((long long) inode)); @@ -921,7 +920,7 @@ StatOpenFile( static int FileGetOptionProc( - void *instanceData, /* The file state. */ + void *instanceData, /* The file state. */ Tcl_Interp *interp, /* For error reporting. */ const char *optionName, /* What option to read, or NULL for all. */ Tcl_DString *dsPtr) /* Where to write the value read. */ @@ -1219,7 +1218,7 @@ TclpOpenFileChannel( Tcl_Channel Tcl_MakeFileChannel( - void *rawHandle, /* OS level handle */ + void *rawHandle, /* OS level handle */ int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { @@ -1467,8 +1466,8 @@ TclpGetDefaultStdChannel( * Set up the normal channel options for stdio handles. */ - if (Tcl_SetChannelOption(NULL, channel, "-translation", "auto")!=TCL_OK || - Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode)!=TCL_OK) { + if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK || + Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) { Tcl_CloseEx(NULL, channel, 0); return (Tcl_Channel) NULL; } @@ -1688,7 +1687,7 @@ FileGetType( return type; } -/* + /* *---------------------------------------------------------------------- * * NativeIsComPort -- diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index e655195..8b289b1 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -94,10 +94,10 @@ static int gInitialized = 0; * and bufPtr[0]:bufPtr[length - (size-start)]. */ typedef struct RingBuffer { - char *bufPtr; /* Pointer to buffer storage */ - Tcl_Size capacity; /* Size of the buffer in RingBufferChar */ - Tcl_Size start; /* Start of the data within the buffer. */ - Tcl_Size length; /* Number of RingBufferChar*/ + char *bufPtr; /* Pointer to buffer storage */ + Tcl_Size capacity; /* Size of the buffer in RingBufferChar */ + Tcl_Size start; /* Start of the data within the buffer. */ + Tcl_Size length; /* Number of RingBufferChar*/ } RingBuffer; #define RingBufferLength(ringPtr_) ((ringPtr_)->length) #define RingBufferHasFreeSpace(ringPtr_) ((ringPtr_)->length < (ringPtr_)->capacity) @@ -125,28 +125,25 @@ typedef struct RingBuffer { * from gConsoleHandleInfoList. */ typedef struct ConsoleHandleInfo { - struct ConsoleHandleInfo *nextPtr; - /* Process-global list of consoles */ - HANDLE console; /* Console handle */ - HANDLE consoleThread; /* Handle to thread doing actual i/o on the - * console */ - SRWLOCK lock; /* Controls access to this structure. - * Cheaper than CRITICAL_SECTION but note does - * not support recursive locks or Try* style - * attempts.*/ + struct ConsoleHandleInfo *nextPtr; /* Process-global list of consoles */ + HANDLE console; /* Console handle */ + HANDLE consoleThread; /* Handle to thread doing actual i/o on the console */ + SRWLOCK lock; /* Controls access to this structure. + * Cheaper than CRITICAL_SECTION but note does not + * support recursive locks or Try* style attempts.*/ CONDITION_VARIABLE consoleThreadCV;/* For awakening console thread */ CONDITION_VARIABLE interpThreadCV; /* For awakening interpthread(s) */ - RingBuffer buffer; /* Buffer for data transferred between console - * threads and Tcl threads. For input consoles, - * written by the console thread and read by Tcl - * threads. The converse for output threads */ - DWORD initMode; /* Initial console mode. */ - DWORD lastError; /* An error caused by the last background - * operation. Set to 0 if no error has been - * detected. */ - int numRefs; /* See comments above */ - int permissions; /* TCL_READABLE for input consoles, TCL_WRITABLE - * for output. Only one or the other can be set. */ + RingBuffer buffer; /* Buffer for data transferred between console + * threads and Tcl threads. For input consoles, + * written by the console thread and read by Tcl + * threads. The converse for output threads */ + DWORD initMode; /* Initial console mode. */ + DWORD lastError; /* An error caused by the last background + * operation. Set to 0 if no error has been + * detected. */ + int numRefs; /* See comments above */ + int permissions; /* TCL_READABLE for input consoles, TCL_WRITABLE + * for output. Only one or the other can be set. */ int flags; #define CONSOLE_DATA_AWAITED 0x0001 /* An interpreter is awaiting data */ } ConsoleHandleInfo; @@ -186,7 +183,7 @@ typedef struct ConsoleChannelInfo { Tcl_Channel channel; /* Pointer to channel structure. */ DWORD initMode; /* Initial console mode. */ int numRefs; /* See comments above */ - int permissions; /* OR'ed combination of TCL_READABLE, + int permissions; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which operations are valid on the file. */ int watchMask; /* OR'ed combination of TCL_READABLE, @@ -301,23 +298,23 @@ static ConsoleChannelInfo *gWatchingChannelList; */ static const Tcl_ChannelType consoleChannelType = { - "console", /* Type name. */ - TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Old close proc. Deprecated */ - ConsoleInputProc, /* Input proc. */ - ConsoleOutputProc, /* Output proc. */ - NULL, /* Seek proc. Not seekable. Deprecated */ - ConsoleSetOptionProc, /* Set option proc. */ - ConsoleGetOptionProc, /* Get option proc. */ - ConsoleWatchProc, /* Set up notifier to watch the channel. */ - ConsoleGetHandleProc, /* Get an OS handle from channel. */ - ConsoleCloseProc, /* New close2 proc. */ - ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ - NULL, /* Flush proc. */ - NULL, /* Handler proc. */ - NULL, /* Wide seek proc. Not seekable */ - ConsoleThreadActionProc, /* Thread action proc. */ - NULL /* Truncation proc. */ + "console", /* Type name. */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ + NULL, /* Close proc. */ + ConsoleInputProc, /* Input proc. */ + ConsoleOutputProc, /* Output proc. */ + NULL, /* Seek proc. */ + ConsoleSetOptionProc, /* Set option proc. */ + ConsoleGetOptionProc, /* Get option proc. */ + ConsoleWatchProc, /* Set up notifier to watch the channel. */ + ConsoleGetHandleProc, /* Get an OS handle from channel. */ + ConsoleCloseProc, /* close2proc. */ + ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ + NULL, /* Flush proc. */ + NULL, /* Handler proc. */ + NULL, /* Wide seek proc. */ + ConsoleThreadActionProc, /* Thread action proc. */ + NULL /* Truncation proc. */ }; /* @@ -757,8 +754,8 @@ NudgeWatchers( * * This procedure is invoked before Tcl_DoOneEvent blocks waiting for an * event. It walks the channel list and if any input channel has data - * available or output channel has space for data, sets the event loop - * blocking time to 0 so that it will poll immediately. + * available or output channel has space for data, sets the event loop + * blocking time to 0 so that it will poll immediately. * * Results: * None. @@ -2002,13 +1999,13 @@ ConsoleWriterThread( */ static ConsoleHandleInfo * AllocateConsoleHandleInfo( - HANDLE consoleHandle, /* Actual handle to console. */ - int permissions) /* TCL_READABLE or TCL_WRITABLE */ + HANDLE consoleHandle, + int permissions) /* TCL_READABLE or TCL_WRITABLE */ { ConsoleHandleInfo *handleInfoPtr; DWORD consoleMode; - handleInfoPtr = (ConsoleHandleInfo *) Tcl_Alloc(sizeof(*handleInfoPtr)); + handleInfoPtr = (ConsoleHandleInfo *)Tcl_Alloc(sizeof(*handleInfoPtr)); memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); handleInfoPtr->console = consoleHandle; InitializeSRWLock(&handleInfoPtr->lock); @@ -2026,14 +2023,12 @@ AllocateConsoleHandleInfo( SetConsoleMode(consoleHandle, consoleMode); } handleInfoPtr->consoleThread = CreateThread( - NULL, /* default security descriptor */ - 2 * CONSOLE_BUFFER_SIZE, /* Stack size, rounded up to granularity */ - permissions == TCL_READABLE - ? ConsoleReaderThread - : ConsoleWriterThread, - handleInfoPtr, /* Pass to thread */ - 0, /* Flags - no special cases */ - NULL); /* Don't care about thread id */ + NULL, /* default security descriptor */ + 2*CONSOLE_BUFFER_SIZE, /* Stack size - gets rounded up to granularity */ + permissions == TCL_READABLE ? ConsoleReaderThread : ConsoleWriterThread, + handleInfoPtr, /* Pass to thread */ + 0, /* Flags - no special cases */ + NULL); /* Don't care about thread id */ if (handleInfoPtr->consoleThread == NULL) { /* Note - SRWLock and condition variables do not need finalization */ RingBufferClear(&handleInfoPtr->buffer); @@ -2262,7 +2257,7 @@ ConsoleThreadActionProc( */ static int ConsoleSetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ @@ -2351,7 +2346,7 @@ ConsoleSetOptionProc( static int ConsoleGetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 86fde1a..f36407d 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -92,10 +92,8 @@ TCL_DECLARE_MUTEX(ddeMutex) #if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a, b, c) \ - Tcl_WinTCharToUtf((TCHAR *)(a), (b) * sizeof(WCHAR), c) -# define Tcl_UtfToWCharDString(a, b, c) \ - (WCHAR *)Tcl_WinUtfToTChar(a, b, c) +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) # else # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString @@ -312,10 +310,10 @@ Initialize(void) static const WCHAR * DdeSetServerName( Tcl_Interp *interp, - const WCHAR *name, /* The name that will be used to refer to the + const WCHAR *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ - int flags, /* DDE_FLAG_FORCE or 0 */ + int flags, /* DDE_FLAG_FORCE or 0 */ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { @@ -517,7 +515,7 @@ DdeGetRegistrationPtr( static void DeleteProc( - void *clientData) /* The interp we are deleting. */ + void *clientData) /* The interp we are deleting. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; RegisteredInterp *searchPtr, *prevPtr; @@ -1305,9 +1303,9 @@ SetDdeError( static int DdeObjCmd( - void *dummy, /* Not used. */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* The interp we are sending from */ - Tcl_Size objc, /* Number of arguments */ + Tcl_Size objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { static const char *const ddeCommands[] = { @@ -1326,7 +1324,7 @@ DdeObjCmd( "-async", "-binary", NULL }; enum DdeExecOptions { - DDE_EXEC_ASYNC, DDE_EXEC_BINARY + DDE_EXEC_ASYNC, DDE_EXEC_BINARY }; static const char *const ddeEvalOptions[] = { "-async", NULL diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index b6db893..0af484d 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -904,8 +904,8 @@ TclpObjCopyDirectory( Tcl_Obj *normSrcPtr, *normDestPtr; int ret; - normSrcPtr = Tcl_FSGetNormalizedPath(NULL, srcPathPtr); - normDestPtr = Tcl_FSGetNormalizedPath(NULL, destPathPtr); + normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr); + normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr); if ((normSrcPtr == NULL) || (normDestPtr == NULL)) { return TCL_ERROR; } @@ -1711,8 +1711,8 @@ ConvertFileNameFormat( Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp); Tcl_DStringFree(&ds); - tempPath = Tcl_DStringToObj(&dsTemp); - Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); + tempPath = Tcl_DStringToObj(&dsTemp); + Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); FindClose(handle); } } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 2f43ed2..17f4898 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -497,8 +497,7 @@ TclWinSymLinkDelete( if (hFile != INVALID_HANDLE_VALUE) { if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, - REPARSE_MOUNTPOINT_HEADER_SIZE, NULL, 0, &returnedLength, - NULL)) { + REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) { /* * Error setting junction. */ @@ -584,7 +583,7 @@ WinReadLinkDirectory( */ if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer, - L"\\??\\Volume{", 11) == 0) { + L"\\??\\Volume{",11) == 0) { char drive; /* @@ -607,7 +606,7 @@ WinReadLinkDirectory( }; driveSpec[0] = drive; - retVal = Tcl_NewStringObj(driveSpec, 2); + retVal = Tcl_NewStringObj(driveSpec,2); Tcl_IncrRefCount(retVal); return retVal; } @@ -624,14 +623,14 @@ WinReadLinkDirectory( goto invalidError; } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer - .PathBuffer, L"\\\\?\\", 4) == 0) { + .PathBuffer, L"\\\\?\\",4) == 0) { /* * Strip off the prefix. */ offset = 4; } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer - .PathBuffer, L"\\??\\", 4) == 0) { + .PathBuffer, L"\\??\\",4) == 0) { /* * Strip off the prefix. */ @@ -646,9 +645,9 @@ WinReadLinkDirectory( reparseBuffer->MountPointReparseBuffer .SubstituteNameLength>>1, &ds); - copy = Tcl_DStringValue(&ds) + offset; - len = Tcl_DStringLength(&ds) - offset; - retVal = Tcl_NewStringObj(copy, len); + copy = Tcl_DStringValue(&ds)+offset; + len = Tcl_DStringLength(&ds)-offset; + retVal = Tcl_NewStringObj(copy,len); Tcl_IncrRefCount(retVal); Tcl_DStringFree(&ds); return retVal; @@ -1439,23 +1438,23 @@ TclpGetUserHome( if (domain == NULL) { const char *ptr; - /* - * Treat the current user as a special case because the general case - * below does not properly retrieve the path. The NetUserGetInfo - * call returns an empty path and the code defaults to the user's - * name in the profiles directory. On modern Windows systems, this - * is generally wrong as when the account is a Microsoft account, - * for example abcdefghi@outlook.com, the directory name is - * abcde and not abcdefghi. - * - * Note we could have just used env(USERPROFILE) here but - * the intent is to retrieve (as on Unix) the system's view - * of the home irrespective of environment settings of HOME - * and USERPROFILE. - * - * Fixing this for the general user needs more investigating but - * at least for the current user we can use a direct call. - */ + /* + * Treat the current user as a special case because the general case + * below does not properly retrieve the path. The NetUserGetInfo + * call returns an empty path and the code defaults to the user's + * name in the profiles directory. On modern Windows systems, this + * is generally wrong as when the account is a Microsoft account, + * for example abcdefghi@outlook.com, the directory name is + * abcde and not abcdefghi. + * + * Note we could have just used env(USERPROFILE) here but + * the intent is to retrieve (as on Unix) the system's view + * of the home irrespective of environment settings of HOME + * and USERPROFILE. + * + * Fixing this for the general user needs more investigating but + * at least for the current user we can use a direct call. + */ ptr = TclpGetUserName(&ds); if (ptr != NULL && strcasecmp(name, ptr) == 0) { HANDLE hProcess; @@ -1750,8 +1749,8 @@ NativeAccess( * go). */ - if(!GetSecurityDescriptorOwner(sdPtr, &pSid, &SidDefaulted) || - memcmp(GetSidIdentifierAuthority(pSid), &samba_unmapped, + if(!GetSecurityDescriptorOwner(sdPtr,&pSid,&SidDefaulted) || + memcmp(GetSidIdentifierAuthority(pSid),&samba_unmapped, sizeof(SID_IDENTIFIER_AUTHORITY))==0) { HeapFree(GetProcessHeap(), 0, sdPtr); return 0; /* Attrib tests say access allowed. */ @@ -1894,7 +1893,7 @@ NativeIsExec( int TclpObjChdir( - Tcl_Obj *pathPtr) /* Path to new working directory. */ + Tcl_Obj *pathPtr) /* Path to new working directory. */ { int result; const WCHAR *nativePath; @@ -2054,28 +2053,28 @@ NativeStat( if (fileHandle != INVALID_HANDLE_VALUE) { BY_HANDLE_FILE_INFORMATION data; - if (GetFileInformationByHandle(fileHandle, &data) != TRUE) { - fileType = GetFileType(fileHandle); - CloseHandle(fileHandle); - if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) { - Tcl_SetErrno(ENOENT); - return -1; - } + if (GetFileInformationByHandle(fileHandle,&data) != TRUE) { + fileType = GetFileType(fileHandle); + CloseHandle(fileHandle); + if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) { + Tcl_SetErrno(ENOENT); + return -1; + } - /* + /* * Mock up the expected structure */ - memset(&data, 0, sizeof(data)); - statPtr->st_atime = 0; - statPtr->st_mtime = 0; - statPtr->st_ctime = 0; - } else { - CloseHandle(fileHandle); - statPtr->st_atime = ToCTime(data.ftLastAccessTime); - statPtr->st_mtime = ToCTime(data.ftLastWriteTime); - statPtr->st_ctime = ToCTime(data.ftCreationTime); - } + memset(&data, 0, sizeof(data)); + statPtr->st_atime = 0; + statPtr->st_mtime = 0; + statPtr->st_ctime = 0; + } else { + CloseHandle(fileHandle); + statPtr->st_atime = ToCTime(data.ftLastAccessTime); + statPtr->st_mtime = ToCTime(data.ftLastWriteTime); + statPtr->st_ctime = ToCTime(data.ftCreationTime); + } attr = data.dwFileAttributes; statPtr->st_size = ((long long) data.nFileSizeLow) | (((long long) data.nFileSizeHigh) << 32); @@ -2135,11 +2134,11 @@ NativeStat( dev = NativeDev(nativePath); mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath)); if (fileType == FILE_TYPE_CHAR) { - mode &= ~S_IFMT; - mode |= S_IFCHR; + mode &= ~S_IFMT; + mode |= S_IFCHR; } else if (fileType == FILE_TYPE_DISK) { - mode &= ~S_IFMT; - mode |= S_IFBLK; + mode &= ~S_IFMT; + mode |= S_IFBLK; } statPtr->st_dev = (dev_t) dev; @@ -2521,9 +2520,9 @@ TclpFilesystemPathType( int TclpObjNormalizePath( TCL_UNUSED(Tcl_Interp *), - Tcl_Obj *pathPtr, /* An unshared object containing the path to + Tcl_Obj *pathPtr, /* An unshared object containing the path to * normalize */ - int nextCheckpoint) /* offset to start at in pathPtr */ + int nextCheckpoint) /* offset to start at in pathPtr */ { char *lastValidPathEnd = NULL; Tcl_DString dsNorm; /* This will hold the normalized string. */ @@ -2871,7 +2870,7 @@ TclWinVolumeRelativeNormalize( const char *drive = TclGetString(useThisCwd); - absolutePath = Tcl_NewStringObj(drive, 2); + absolutePath = Tcl_NewStringObj(drive,2); Tcl_AppendToObj(absolutePath, path, TCL_INDEX_NONE); Tcl_IncrRefCount(absolutePath); @@ -2973,10 +2972,10 @@ TclpNativeToNormalized( */ if (*copy == '\\') { - if (0 == strncmp(copy, "\\??\\", 4)) { + if (0 == strncmp(copy,"\\??\\",4)) { copy += 4; len -= 4; - } else if (0 == strncmp(copy, "\\\\?\\", 4)) { + } else if (0 == strncmp(copy,"\\\\?\\",4)) { copy += 4; len -= 4; } @@ -2992,7 +2991,7 @@ TclpNativeToNormalized( } } - objPtr = Tcl_NewStringObj(copy, len); + objPtr = Tcl_NewStringObj(copy,len); Tcl_DStringFree(&ds); return objPtr; @@ -3258,8 +3257,8 @@ TclpUtime( * TclWinFileOwned -- * * Returns 1 if the specified file exists and is owned by the current - * user and 0 otherwise. Like the Unix case, the check is made using - * the real process SID, not the effective (impersonation) one. + * user and 0 otherwise. Like the Unix case, the check is made using + * the real process SID, not the effective (impersonation) one. * *--------------------------------------------------------------------------- */ @@ -3281,12 +3280,12 @@ TclWinFileOwned( if (GetNamedSecurityInfoW((LPWSTR) native, SE_FILE_OBJECT, OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL, &secd) != ERROR_SUCCESS) { - /* + /* * Either not a file, or we do not have access to it in which case we * are in all likelihood not the owner. */ - return 0; + return 0; } /* @@ -3297,19 +3296,19 @@ TclWinFileOwned( */ if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) { - /* + /* * Find out how big the buffer needs to be. */ - bufsz = 0; - GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); - if (bufsz) { - buf = (LPBYTE)Tcl_Alloc(bufsz); - if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { - owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); - } - } - CloseHandle(token); + bufsz = 0; + GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); + if (bufsz) { + buf = (LPBYTE)Tcl_Alloc(bufsz); + if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { + owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); + } + } + CloseHandle(token); } /* @@ -3317,13 +3316,13 @@ TclWinFileOwned( */ if (secd) { - LocalFree(secd); /* Also frees ownerSid */ + LocalFree(secd); /* Also frees ownerSid */ } if (buf) { - Tcl_Free(buf); + Tcl_Free(buf); } - return (owned != 0); /* Convert non-0 to 1 */ + return (owned != 0); /* Convert non-0 to 1 */ } /* diff --git a/win/tclWinInit.c b/win/tclWinInit.c index ac26a81..4234ceb 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -516,14 +516,14 @@ TclpSetVariables( Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); } else { - /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ - ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); - if (ptr != NULL && ptr[0]) { - Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); - } else { - /* Last resort */ - Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); - } + /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ + ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); + if (ptr != NULL && ptr[0]) { + Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); + } else { + /* Last resort */ + Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); + } } } @@ -542,7 +542,7 @@ TclpSetVariables( * Define what the platform PATH separator is. [TIP #315] */ - Tcl_SetVar2(interp, "tcl_platform", "pathSeparator", ";", TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY); } /* @@ -570,7 +570,7 @@ Tcl_Size TclpFindVariable( const char *name, /* Name of desired environment variable * (UTF-8). */ - Tcl_Size *lengthPtr) /* Used to return length of name (for + Tcl_Size *lengthPtr) /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 4456d53..9995602 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -51,7 +51,7 @@ MODULE_SCOPE int TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal, const WCHAR *LinkCopy); MODULE_SCOPE int TclWinSymLinkDelete(const WCHAR *LinkOriginal, int linkOnly); -MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); +MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); MODULE_SCOPE void TclWinGenerateChannelName(char channelName[], const char *channelTypeName, void *channelImpl); MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr); diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index d406c7f..1cc7ae1 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -90,11 +90,11 @@ TclpDlopen( Tcl_DString ds; - /* - * Remember the first error on load attempt to be used if the - * second load attempt below also fails. - */ - firstError = (nativeName == NULL) ? + /* + * Remember the first error on load attempt to be used if the + * second load attempt below also fails. + */ + firstError = (nativeName == NULL) ? ERROR_MOD_NOT_FOUND : GetLastError(); Tcl_DStringInit(&ds); @@ -106,19 +106,19 @@ TclpDlopen( if (hInstance == NULL) { DWORD lastError; - Tcl_Obj *errMsg; - - /* - * We choose to only use the error from the second call if the first - * call failed due to the file not being found. Else stick to the - * first error for reporting purposes. - */ - if (firstError == ERROR_MOD_NOT_FOUND || + Tcl_Obj *errMsg; + + /* + * We choose to only use the error from the second call if the first + * call failed due to the file not being found. Else stick to the + * first error for reporting purposes. + */ + if (firstError == ERROR_MOD_NOT_FOUND || firstError == ERROR_DLL_NOT_FOUND) { - lastError = GetLastError(); - } else { - lastError = firstError; - } + lastError = GetLastError(); + } else { + lastError = firstError; + } errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", TclGetString(pathPtr)); @@ -157,11 +157,11 @@ TclpDlopen( Tcl_AppendToObj(errMsg, "the library initialization" " routine failed", TCL_INDEX_NONE); break; - case ERROR_BAD_EXE_FORMAT: + case ERROR_BAD_EXE_FORMAT: Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", (char *)NULL); Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", TCL_INDEX_NONE); - break; - default: + break; + default: Tcl_WinConvertError(lastError); Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), TCL_INDEX_NONE); } diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index dbeea14..2c93a41 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -148,7 +148,7 @@ TclpInitNotifier(void) void TclpFinalizeNotifier( - void *clientData) /* Pointer to notifier data. */ + void *clientData) /* Pointer to notifier data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -218,7 +218,7 @@ TclpFinalizeNotifier( void TclpAlertNotifier( - void *clientData) /* Pointer to thread data. */ + void *clientData) /* Pointer to thread data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -264,7 +264,7 @@ TclpAlertNotifier( void TclpSetTimer( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); UINT timeout; @@ -370,9 +370,9 @@ int TclAsyncNotifier( TCL_UNUSED(int), /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(void *), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ TCL_UNUSED(int *), /* Flag to mark. */ - TCL_UNUSED(int)) /* Value of mark. */ + TCL_UNUSED(int)) /* Value of mark. */ { return 0; } @@ -464,7 +464,7 @@ TclpNotifierData(void) int TclpWaitForEvent( - const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ + const Tcl_Time *timePtr) /* Maximum block time, or NULL. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); MSG msg; diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 1f80e7a..dbf3324 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -203,7 +203,7 @@ static void PipeThreadActionProc(void *instanceData, static const Tcl_ChannelType pipeChannelType = { "pipe", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ PipeInputProc, /* Input proc. */ PipeOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -916,7 +916,7 @@ TclpCreateProcess( * occurred when creating the child process. * Error messages from the child process * itself are sent to errorFile. */ - size_t argc, /* Number of arguments in following array. */ + size_t argc, /* Number of arguments in following array. */ const char **argv, /* Array of argument strings. argv[0] contains * the name of the executable converted to * native format (using the @@ -1540,7 +1540,7 @@ static void BuildCommandLine( const char *executable, /* Full path of executable (including * extension). Replacement for argv[0]. */ - size_t argc, /* Number of arguments. */ + size_t argc, /* Number of arguments. */ const char **argv, /* Argument strings in UTF. */ Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the * command line (WCHAR). */ @@ -1957,7 +1957,7 @@ TclGetAndDetachPids( static int PipeBlockModeProc( - void *instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -1996,7 +1996,7 @@ PipeBlockModeProc( static int PipeClose2Proc( - void *instanceData, /* Pointer to PipeInfo structure. */ + void *instanceData, /* Pointer to PipeInfo structure. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { @@ -2167,7 +2167,7 @@ PipeClose2Proc( static int PipeInputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -2261,7 +2261,7 @@ PipeInputProc( static int PipeOutputProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -2409,7 +2409,7 @@ PipeEventProc( mask = TCL_WRITABLE; } - if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr, 0) >= 0)) { + if ((infoPtr->watchMask & TCL_READABLE) && (WaitForRead(infoPtr,0) >= 0)) { if (infoPtr->readFlags & PIPE_EOF) { mask = TCL_READABLE; } else { @@ -2443,7 +2443,7 @@ PipeEventProc( static void PipeWatchProc( - void *instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -2505,9 +2505,9 @@ PipeWatchProc( static int PipeGetHandleProc( - void *instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { PipeInfo *infoPtr = (PipeInfo *) instanceData; WinFile *filePtr; diff --git a/win/tclWinPort.h b/win/tclWinPort.h index d426e7d..8ab4548 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -512,12 +512,12 @@ typedef DWORD_PTR * PDWORD_PTR; * use by tclAlloc.c. */ -#define TclpSysAlloc(size) \ - ((void*)HeapAlloc(GetProcessHeap(), 0, size)) -#define TclpSysFree(ptr) \ - (HeapFree(GetProcessHeap(), 0, (HGLOBAL)ptr)) -#define TclpSysRealloc(ptr, size) \ - ((void*)HeapReAlloc(GetProcessHeap(), 0, (LPVOID)ptr, size)) +#define TclpSysAlloc(size) ((void*)HeapAlloc(GetProcessHeap(), \ + 0, size)) +#define TclpSysFree(ptr) (HeapFree(GetProcessHeap(), \ + 0, (HGLOBAL)ptr)) +#define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \ + 0, (LPVOID)ptr, size)) /* This type is not defined in the Windows headers */ #define socklen_t int diff --git a/win/tclWinReg.c b/win/tclWinReg.c index fc495ed..68e22cb 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -88,10 +88,8 @@ static DWORD lastType = REG_RESOURCE_LIST; #if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a, b, c) \ - Tcl_WinTCharToUtf((TCHAR *)(a), (b) * sizeof(WCHAR), c) -# define Tcl_UtfToWCharDString(a, b, c) \ - (WCHAR *)Tcl_WinUtfToTChar(a, b, c) +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) # else # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString @@ -295,9 +293,9 @@ DeleteCmd( static int RegistryObjCmd( - void *dummy, /* Not used. */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Size n = 1, argc; @@ -937,7 +935,7 @@ GetValueNames( */ size = MAX_KEY_LENGTH; - while (RegEnumValueW(key, index, (WCHAR *)Tcl_DStringValue(&buffer), + while (RegEnumValueW(key,index, (WCHAR *)Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { Tcl_DStringInit(&ds); Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&buffer), size, &ds); @@ -1431,7 +1429,7 @@ SetValue( static int BroadcastValue( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { LRESULT result; diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 66a1540..e27937e 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -204,7 +204,7 @@ static int SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf, static const Tcl_ChannelType serialChannelType = { "serial", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ SerialInputProc, /* Input proc. */ SerialOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -218,7 +218,7 @@ static const Tcl_ChannelType serialChannelType = { NULL, /* handler proc. */ NULL, /* wide seek proc */ SerialThreadActionProc, /* thread action proc */ - NULL /* truncate */ + NULL /* truncate */ }; /* @@ -854,7 +854,7 @@ SerialBlockingWrite( static int SerialInputProc( - void *instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -961,7 +961,7 @@ SerialInputProc( static int SerialOutputProc( - void *instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -1191,7 +1191,7 @@ SerialEventProc( static void SerialWatchProc( - void *instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1248,9 +1248,9 @@ SerialWatchProc( static int SerialGetHandleProc( - void *instanceData, /* The serial state. */ + void *instanceData, /* The serial state. */ TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; @@ -1610,7 +1610,7 @@ SerialModemStatusStr( static int SerialSetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ @@ -2034,7 +2034,7 @@ SerialSetOptionProc( static int SerialGetOptionProc( - void *instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ diff --git a/win/tclWinSock.c b/win/tclWinSock.c index c11413c..49f445d 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1289,7 +1289,7 @@ TcpGetOptionProc( int reverseDNS = 0; #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" #define HAVE_OPTION(option) \ - ((len > 1) && (optionName[1] == option[1]) && \ + ((len > 1) && (optionName[1] == option[1]) && \ (strncmp(optionName, option, len) == 0)) /* @@ -2655,7 +2655,7 @@ SocketEventProc( */ SetEvent(tsdPtr->socketListLock); - WaitForConnect(statePtr, NULL); + WaitForConnect(statePtr,NULL); } else { /* * No async connect reenter pending. Just clear event. diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index dee606b..d5c582b 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -218,8 +218,8 @@ TclpThreadCreate( EnterCriticalSection(&joinLock); - *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and - * on WIN64 sizeof void* != sizeof unsigned */ + *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and + * on WIN64 sizeof void* != sizeof unsigned */ #if defined(_MSC_VER) || defined(__MSVCRT__) tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize, -- cgit v0.12 From 94b3021f045e53c850795d0115c2e08fdab93671 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 14 May 2024 12:47:16 +0000 Subject: (cherry-pick) Merge [4a1848c27fd63955], bringing Tcl.n back to the state it was. --- doc/Tcl.n | 315 ++++++++++++++++++++++++++++++++++++++------------------------ 1 file changed, 194 insertions(+), 121 deletions(-) diff --git a/doc/Tcl.n b/doc/Tcl.n index 99af4df..0f784af 100644 --- a/doc/Tcl.n +++ b/doc/Tcl.n @@ -1,7 +1,6 @@ '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" Copyright (c) 2023 Nathan Coulter '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -17,152 +16,178 @@ Summary of Tcl language syntax. .SH DESCRIPTION .PP The following rules define the syntax and semantics of the Tcl language: -. -.IP "[1] \fBScript.\fR" -A script is composed of zero or more commands delimited by semi-colons or -newlines. -.IP "[2] \fBCommand.\fR" -A command is composed of zero or more words delimited by whitespace. The -replacement for a substitution is included verbatim in the word. For example, a -space in the replacement is included in the word rather than becoming a -delimiter, and \fI\\\\\fR becomes a single backslash in the word. Each word is -processed from left to right and each substitution is performed as soon as it -is complete. -For example, the command -.RS -.PP -.CS -set y [set x 0][incr x][incr x] -.CE -.PP -is composed of three words, and sets the value of \fIy\fR to \fI012\fR. -.PP -If hash -.PQ # -is the first character of what would otherwise be the first word of a command, -all characters up to the next newline are ignored. -.RE -. -.IP "[3] \fBBraced word.\fR" -If a word is enclosed in braces -.PQ { -and -.PQ } "" -, the braces are removed and the enclosed characters become the word. No -substitutions are performed. Nested pairs of braces may occur within the word. -A brace preceded by an odd number of backslashes is not considered part of a -pair, and neither brace nor the backslashes are removed from the word. -. -.IP "[4] \fBQuoted word.\fR" -If a word is enclosed in double quotes +.IP "[1] \fBCommands.\fR" +A Tcl script is a string containing one or more commands. +Semi-colons and newlines are command separators unless quoted as +described below. +Close brackets are command terminators during command substitution +(see below) unless quoted. +.IP "[2] \fBEvaluation.\fR" +A command is evaluated in two steps. +First, the Tcl interpreter breaks the command into \fIwords\fR +and performs substitutions as described below. +These substitutions are performed in the same way for all +commands. +Secondly, the first word is used to locate a routine to +carry out the command, and the remaining words of the command are +passed to that routine. +The routine is free to interpret each of its words +in any way it likes, such as an integer, variable name, list, +or Tcl script. +Different commands interpret their words differently. +.IP "[3] \fBWords.\fR" +Words of a command are separated by white space (except for +newlines, which are command separators). +.IP "[4] \fBDouble quotes.\fR" +If the first character of a word is double-quote .PQ \N'34' -, the double quotes are removed and the enclosed characters become the word. -Substitutions are performed. -. -.IP "[5] \fBList.\fR" -A list has the form of a single command. Newline is whitespace, and semicolon -has no special interpretation. There is no script evaluation so there is no -argument expansion, variable substitution, or command substitution: Dollar-sign -and open bracket have no special interpretation, and what would be argument -expansion in a script is invalid in a list. -. -.IP "[6] \fBArgument expansion.\fR" -If +then the word is terminated by the next double-quote character. +If semi-colons, close brackets, or white space characters +(including newlines) appear between the quotes then they are treated +as ordinary characters and included in the word. +Command substitution, variable substitution, and backslash substitution +are performed on the characters between the quotes as described below. +The double-quotes are not retained as part of the word. +.IP "[5] \fBArgument expansion.\fR" +If a word starts with the string .QW {*} -prefixes a word, it is removed. After any remaining enclosing braces or quotes -are processed and applicable substitutions performed, the word, which must -be a list, is removed from the command, and in its place each word in the -list becomes an additional word in the command. For example, -.CS -cmd a {*}{b [c]} d {*}{$e f {g h}} -.CE +followed by a non-whitespace character, then the leading +.QW {*} +is removed and the rest of the word is parsed and substituted as any other +word. After substitution, the word is parsed as a list (without command or +variable substitutions; backslash substitutions are performed as is normal for +a list and individual internal words may be surrounded by either braces or +double-quote characters), and its words are added to the command being +substituted. For instance, +.QW "cmd a {*}{b [c]} d {*}{$e f {g h}}" is equivalent to -.CS -cmd a b {[c]} d {$e} f {g h} . -.CE -. -.IP "[7] \fBEvaluation.\fR" -To evaluate a script, an interpreter evaluates each successive command. The -first word identifies a procedure, and the remaining words are passed to that -procedure for further evaluation. The procedure interprets each argument in -its own way, e.g. as an integer, variable name, list, mathematical expression, -script, or in some other arbitrary way. The result of the last command is the -result of the script. -. -.IP "[8] \fBCommand substitution.\fR" -Each pair of brackets +.QW "cmd a b {[c]} d {$e} f {g h}" . +.IP "[6] \fBBraces.\fR" +If the first character of a word is an open brace +.PQ { +and rule [5] does not apply, then +the word is terminated by the matching close brace +.PQ } "" . +Braces nest within the word: for each additional open +brace there must be an additional close brace (however, +if an open brace or close brace within the word is +quoted with a backslash then it is not counted in locating the +matching close brace). +No substitutions are performed on the characters between the +braces except for backslash-newline substitutions described +below, nor do semi-colons, newlines, close brackets, +or white space receive any special interpretation. +The word will consist of exactly the characters between the +outer braces, not including the braces themselves. +.IP "[7] \fBCommand substitution.\fR" +If a word contains an open bracket .PQ [ -and -.PQ ] "" -encloses a script and is replaced by the result of that script. -.IP "[9] \fBVariable substitution.\fR" -Each of the following forms begins with dollar sign +then Tcl performs \fIcommand substitution\fR. +To do this it invokes the Tcl interpreter recursively to process +the characters following the open bracket as a Tcl script. +The script may contain any number of commands and must be terminated +by a close bracket +.PQ ] "" . +The result of the script (i.e. the result of its last command) is +substituted into the word in place of the brackets and all of the +characters between them. +There may be any number of command substitutions in a single word. +Command substitution is not performed on words enclosed in braces. +.IP "[8] \fBVariable substitution.\fR" +If a word contains a dollar-sign .PQ $ -and is replaced by the value of the identified variable. \fIname\fR names the -variable and is composed of ASCII letters (\fBA\fR\(en\fBZ\fR and -\fBa\fR\(en\fBz\fR), digits (\fB0\fR\(en\fB9\fR), underscores, or namespace -delimiters (two or more colons). \fIindex\fR is the name of an individual -variable within an array variable, and may be empty. +followed by one of the forms +described below, then Tcl performs \fIvariable +substitution\fR: the dollar-sign and the following characters are +replaced in the word by the value of a variable. +Variable substitution may take any of the following forms: .RS .TP 15 \fB$\fIname\fR . -\fIname\fR may not be empty. - +\fIName\fR is the name of a scalar variable; the name is a sequence +of one or more characters that are a letter, digit, underscore, +or namespace separators (two or more colons). +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). .TP 15 \fB$\fIname\fB(\fIindex\fB)\fR . -\fIname\fR may be empty. Substitutions are performed on \fIindex\fR. +\fIName\fR gives the name of an array variable and \fIindex\fR gives +the name of an element within that array. +\fIName\fR must contain only letters, digits, underscores, and +namespace separators, and may be an empty string. +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). +Command substitutions, variable substitutions, and backslash +substitutions are performed on the characters of \fIindex\fR. .TP 15 \fB${\fIname\fB}\fR -\fIname\fR may be empty. -.TP 15 -\fB${\fIname(index)\fB}\fR . -\fIname\fR may be empty. No substitutions are performed. +\fIName\fR is the name of a scalar variable or array element. It may contain +any characters whatsoever except for close braces. It indicates an array +element if \fIname\fR is in the form +.QW \fIarrayName\fB(\fIindex\fB)\fR +where \fIarrayName\fR does not contain any open parenthesis characters, +.QW \fB(\fR , +or close brace characters, +.QW \fB}\fR , +and \fIindex\fR can be any sequence of characters except for close brace +characters. No further +substitutions are performed during the parsing of \fIname\fR. +.PP +There may be any number of variable substitutions in a single word. +Variable substitution is not performed on words enclosed in braces. +.PP +Note that variables may contain character sequences other than those listed +above, but in that case other mechanisms must be used to access them (e.g., +via the \fBset\fR command's single-argument form). .RE -Variables that are not accessible through one of the forms above may be -accessed through other mechanisms, e.g. the \fBset\fR command. -.IP "[10] \fBBackslash substitution.\fR" -Each backslash +.IP "[9] \fBBackslash substitution.\fR" +If a backslash .PQ \e -that is not part of one of the forms listed below is removed, and the next -character is included in the word verbatim, which allows the inclusion of -characters that would normally be interpreted, namely whitespace, braces, -brackets, double quote, dollar sign, and backslash. The following sequences -are replaced as described: +appears within a word then \fIbackslash substitution\fR occurs. +In all cases but those described below the backslash is dropped and +the following character is treated as an ordinary +character and included in the word. +This allows characters such as double quotes, close brackets, +and dollar signs to be included in words without triggering +special processing. +The following table lists the backslash sequences that are +handled specially, along with the value that replaces each sequence. .RS .RS .RS .TP 7 \e\fBa\fR -Audible alert (bell) (U+7). +Audible alert (bell) (Unicode U+000007). .TP 7 \e\fBb\fR -Backspace (U+8). +Backspace (Unicode U+000008). .TP 7 \e\fBf\fR -Form feed (U+C). +Form feed (Unicode U+00000C). .TP 7 \e\fBn\fR -Newline (U+A). +Newline (Unicode U+00000A). .TP 7 \e\fBr\fR -Carriage-return (U+D). +Carriage-return (Unicode U+00000D). .TP 7 \e\fBt\fR -Tab (U+9). +Tab (Unicode U+000009). .TP 7 \e\fBv\fR -Vertical tab (U+B). +Vertical tab (Unicode U+00000B). .TP 7 \e\fB\fIwhiteSpace\fR . -Newline preceded by an odd number of backslashes, along with the consecutive -spaces and tabs that immediately follow it, is replaced by a single space. -Because this happens before the command is split into words, it occurs even -within braced words, and if the resulting space may subsequently be treated as -a word delimiter. +A single space character replaces the backslash, newline, and all spaces +and tabs after the newline. This backslash sequence is unique in that it +is replaced in a separate pre-pass before the command is actually parsed. +This means that it will be replaced even when it occurs between braces, +and the resulting space will be treated as a word separator if it is not +in braces or quotes. .TP 7 \e\e Backslash @@ -170,30 +195,78 @@ Backslash .TP 7 \e\fIooo\fR . -Up to three octal digits form an eight-bit value for a Unicode character in the -range \fI0\fR\(en\fI377\fR, i.e. U+0\(enU+FF. Only the digits that result in a -number in this range are consumed. +The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal +value for the Unicode character that will be inserted, in the range +\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF). +The parser will stop just before this range overflows, or when +the maximum of three digits is reached. The upper bits of the Unicode +character will be 0. .TP 7 \e\fBx\fIhh\fR . -Up to two hexadecimal digits form an eight-bit value for a Unicode character in -the range \fI0\fR\(en\fIFF\fR. +The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit +hexadecimal value for the Unicode character that will be inserted. The upper +bits of the Unicode character will be 0 (i.e., the character will be in the +range U+000000\(enU+0000FF). .TP 7 \e\fBu\fIhhhh\fR . -Up to four hexadecimal digits form a 16-bit value for a Unicode character in -the range \fI0\fR\(en\fIFFFF\fR. +The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a +sixteen-bit hexadecimal value for the Unicode character that will be +inserted. The upper bits of the Unicode character will be 0 (i.e., the +character will be in the range U+000000\(enU+00FFFF). .TP 7 \e\fBU\fIhhhhhhhh\fR . -Up to eight hexadecimal digits form a 21-bit value for a Unicode character in -the range \fI0\fR\(en\fI10FFFF\fR. Only the digits that result in a number in -this range are consumed. +The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a +twenty-one-bit hexadecimal value for the Unicode character that will be +inserted, in the range U+000000\(enU+10FFFF. The parser will stop just +before this range overflows, or when the maximum of eight digits +is reached. The upper bits of the Unicode character will be 0. .RE .RE .PP +Backslash substitution is not performed on words enclosed in braces, +except for backslash-newline as described above. .RE -. +.IP "[10] \fBComments.\fR" +If a hash character +.PQ # +appears at a point where Tcl is +expecting the first character of the first word of a command, +then the hash character and the characters that follow it, up +through the next newline, are treated as a comment and ignored. +The comment character only has significance when it appears +at the beginning of a command. +.IP "[11] \fBOrder of substitution.\fR" +Each character is processed exactly once by the Tcl interpreter +as part of creating the words of a command. +For example, if variable substitution occurs then no further +substitutions are performed on the value of the variable; the +value is inserted into the word verbatim. +If command substitution occurs then the nested command is +processed entirely by the recursive call to the Tcl interpreter; +no substitutions are performed before making the recursive +call and no additional substitutions are performed on the result +of the nested script. +.RS +.PP +Substitutions take place from left to right, and each substitution is +evaluated completely before attempting to evaluate the next. Thus, a +sequence like +.PP +.CS +set y [set x 0][incr x][incr x] +.CE +.PP +will always set the variable \fIy\fR to the value, \fI012\fR. +.RE +.IP "[12] \fBSubstitution and word boundaries.\fR" +Substitutions do not affect the word boundaries of a command, +except for argument expansion as specified in rule [5]. +For example, during variable substitution the entire value of +the variable becomes part of a single word, even if the variable's +value contains spaces. .SH KEYWORDS backslash, command, comment, script, substitution, variable '\" Local Variables: -- cgit v0.12 From 4c758c453dd722f9b7ebc288ca684981bfd8d58c Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 14 May 2024 18:11:17 +0000 Subject: More conventional Markdown --- changes.md | 130 ++++++++++++++++++++++++++++++------------------------------- 1 file changed, 65 insertions(+), 65 deletions(-) diff --git a/changes.md b/changes.md index 652b701..fbb6b47 100644 --- a/changes.md +++ b/changes.md @@ -2,7 +2,7 @@ The source code for Tcl is managed by fossil. Tcl developers coordinate all changes to the Tcl source code at - https://core.tcl-lang.org/tcl/timeline +> [Tcl Source Code](https://core.tcl-lang.org/tcl/timeline) Release Tcl 9.0b2 arises from the check-in with tag core-9-0-b2. @@ -10,77 +10,77 @@ Highlighted differences between Tcl 9.0 and Tcl 8.6 are summarized below, with focus on changes important to programmers using the Tcl library and writing Tcl scripts. - * 64-bit capacity: Data values larger than 2Gb +## 64-bit capacity: Data values larger than 2Gb - * Internationalization of text - - Full Unicode range of codepoints - - New encodings: utf-16/utf-32/ucs-2(le|be), CESU-8, etc. - - [encoding] options -profile, -failindex manage encoding of I/O. - - [msgcat] supports custom locale search list - - [source] defaults to -encoding utf-8 +## Internationalization of text + - Full Unicode range of codepoints + - New encodings: utf-16/utf-32/ucs-2(le|be), CESU-8, etc. + - `encoding` options -profile, -failindex manage encoding of I/O. + - `msgcat` supports custom locale search list + - `source` defaults to -encoding utf-8 - * Zip filesystems and attached archives. +## Zip filesystems and attached archives. - * Unix notifiers available using epoll() or kqueue() - - relieves limits on file descriptors imposed by legacy select() +## Unix notifiers available using epoll() or kqueue() + - relieves limits on file descriptors imposed by legacy select() - * Notable incompatibilities - - Unqualified varnames resolved in current namespace, not global. - - No --disable-threads build option. Always thread-enabled. - - I/O malencoding default response: raise error (-profile strict) - - Windows platform needs Windows 7 or Windows Server 2008 R2 or later - - Ended interpretation of ~ as home directory in pathnames - - Removed the "identity" encoding - - $::tcl_precision no longer controls string generation of doubles - - Removed Tcl 7 legacies: [case], [puts] [read] variant syntaxes - - Removed subcommands [trace variable|vdelete|vinfo] - - No -eofchar option for channels anymore for writing. - - On Windows 10+ (Version 1903 or higher), system encoding is always utf-8. +## Notable incompatibilities + - Unqualified varnames resolved in current namespace, not global. + - No --disable-threads build option. Always thread-enabled. + - I/O malencoding default response: raise error (-profile strict) + - Windows platform needs Windows 7 or Windows Server 2008 R2 or later + - Ended interpretation of ~ as home directory in pathnames + - Removed the "identity" encoding + - $::tcl_precision no longer controls string generation of doubles + - Removed Tcl 7 legacies: [case], [puts] [read] variant syntaxes + - Removed subcommands [trace variable|vdelete|vinfo] + - No -eofchar option for channels anymore for writing. + - On Windows 10+ (Version 1903 or higher), system encoding is always utf-8. - * Incompatibilities in C public interface - - Many arguments expanded type from int to Tcl_Size - - Ended support for Tcl_ChannelTypeVersion less than 5 - - Introduced versioning of the Tcl_ObjType struct - - Removed macros CONST*: Tcl 9 support means dropping Tcl 8.3 support - - Removed routines: - Tcl_Backslash(), Tcl_*VA(), Tcl_*MathFunc*(), Tcl_MakeSafe(), - Tcl_(Save|Restore|Discard|Free)Result(), Tcl_EvalTokens(), - Tcl_(Get|Set)DefaultEncodingDir(), - Tcl_UniCharN(case)cmp(), Tcl_UniCharCaseMatch() +## Incompatibilities in C public interface + - Many arguments expanded type from int to Tcl_Size + - Ended support for Tcl_ChannelTypeVersion less than 5 + - Introduced versioning of the Tcl_ObjType struct + - Removed macros CONST*: Tcl 9 support means dropping Tcl 8.3 support + - Removed routines: +> Tcl_Backslash(), Tcl_*VA(), Tcl_*MathFunc*(), Tcl_MakeSafe(), +> Tcl_(Save|Restore|Discard|Free)Result(), Tcl_EvalTokens(), +> Tcl_(Get|Set)DefaultEncodingDir(), +> Tcl_UniCharN(case)cmp(), Tcl_UniCharCaseMatch() - * New commands - - [array default], [array for] - - [coroinject], [coroprobe] - - [clock add weekdays] - - [const], [info const*] - - [dict getdefault] - - [file tempdir], [file home], [file tildeexpand] - - [info commandtype] - - [ledit] - - [lpop] - - [lremove] - - [lseq] - - [package files] - - [string insert], [string is dict] - - [tcl::process] - - [*::build-info] +## New commands + - `array default`, `array for` + - `coroinject`, `coroprobe` + - `clock add weekdays` + - `const`, `info const*` + - `dict getdefault` + - `file tempdir`, `file home`, `file tildeexpand` + - `info commandtype` + - `ledit` + - `lpop` + - `lremove` + - `lseq` + - `package files` + - `string insert`, `string is dict` + - `tcl::process` + - `*::build-info` - * New command options - - [regsub ... -command ...] - - [lsearch ... -stride ...] - - [clock scan ... -validate ...] - - [socket ... -nodelay ... -keepalive ...] - - [vwait] controlled by several new options +## New command options + - `regsub ... -command ...` + - `lsearch ... -stride ...` + - `clock scan ... -validate ...` + - `socket ... -nodelay ... -keepalive ...` + - `vwait` controlled by several new options - * Numbers - - 0NNN format is no longer octal interpretation. Use 0oNNN. - - 0dNNNN format to compel decimal interpretation. - - NN_NNN_NNN, underscores in numbers for optional readability - - Functions: isinf() isnan() isnormal() issubnormal() isunordered() - - [fpclassify] - - Function int() no longer truncates to word size +## Numbers + - 0NNN format is no longer octal interpretation. Use 0oNNN. + - 0dNNNN format to compel decimal interpretation. + - NN_NNN_NNN, underscores in numbers for optional readability + - Functions: isinf() isnan() isnormal() issubnormal() isunordered() + - `fpclassify` + - Function int() no longer truncates to word size - * tcl::oo facilities - - private variable and methods - - [method -export], [method -unexport] +## tcl::oo facilities + - private variable and methods + - `method -export`, `method -unexport` -- cgit v0.12 From 43310289525a656579e95344bc46dff9a4f52889 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 14 May 2024 18:37:56 +0000 Subject: Funcs without args must explicitly take void Otherwise C compilers operate in a weird legacy mode which we never want. --- generic/tclClockFmt.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 423b64a..0afc458 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -3567,7 +3567,7 @@ ClockFrmScnClearCaches(void) } void -ClockFrmScnFinalize() +ClockFrmScnFinalize(void) { if (!initialized) { return; -- cgit v0.12 From e117b16718bb1dcd8bdfcff8f5b47f39eea96e4b Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 14 May 2024 18:39:21 +0000 Subject: merge 8.7 (interim fix for [9889f96f4da77e3b]) --- library/init.tcl | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/library/init.tcl b/library/init.tcl index 1209619..7190e95 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -109,17 +109,15 @@ if {[interp issafe]} { # Set up the 'clock' ensemble - proc clock args { + apply {{} { set cmdmap [dict create] foreach cmd {add clicks format microseconds milliseconds scan seconds} { dict set cmdmap $cmd ::tcl::clock::$cmd } namespace inscope ::tcl::clock [list namespace ensemble create -command \ - [uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \ - -map $cmdmap] + ::clock -map $cmdmap] ::tcl::unsupported::clock::configure -init-complete - uplevel 1 [info level 0] - } + }} } # Conditionalize for presence of exec. -- cgit v0.12 From 29378c86101ba625aba8572736fff6f42c8aa184 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 14 May 2024 19:05:43 +0000 Subject: merge 8.7 --- tests/clock.test | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index ef41ad5..0144512 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -273,6 +273,8 @@ proc ::testClock::registry { cmd path key } { # Base test cases: +# no lazy creation of clock-ensemble (interim, bug [9889f96f4da77e3b], [31fd84270644f67d]), +# so ensemble created implicitely in init.tcl test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" -setup { set i [interp create]; # because clock can be used somewhere, test it in new interp: } -body { @@ -286,7 +288,7 @@ test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" -setup { } } -cleanup { interp delete $i -} -result {ens:0 ens:1 stubs:0 stubs:1} +} -result {ens:1 ens:1 stubs:0 stubs:1} test clock-0.1a "initial: safe interpreter shares clock command with parent" -setup { set i [interp create] $i eval {set sci [interp create -safe]} @@ -301,7 +303,7 @@ test clock-0.1a "initial: safe interpreter shares clock command with parent" -se } } -cleanup { interp delete $i -} -result {ens:0 ens:1 stubs:0 stubs:1} +} -result {ens:1 ens:1 stubs:0 stubs:1} test clock-0.2 "initial: loading of format/locale does not overwrite interp state (errorInfo)" -setup { # be sure - we have no cached locale/msgcat, etc: -- cgit v0.12 From 8cc70aa0bf4ca277d37cd7513d180885c0531b56 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 14 May 2024 19:07:38 +0000 Subject: silence warning (implicit-fallthrough) --- generic/tclExecute.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index da08f3a..bd502e8 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -7452,6 +7452,7 @@ TEBCresume( break; default: Tcl_Panic("clockRead instruction with unknown clock#"); + break; } TclNewIntObj(objResultPtr, wval); TRACE_WITH_OBJ(("=> "), objResultPtr); -- cgit v0.12 From 81f89bbb7aae2e50fa468e4a4b6f9f04b0293ea1 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 14 May 2024 19:08:23 +0000 Subject: Merge [4a1848c27fd63955], which was improperly backed-out (there was no notice or public discussion). --- doc/Tcl.n | 323 +++++++++++++++++++++++++++++++++++++------------------------- 1 file changed, 194 insertions(+), 129 deletions(-) diff --git a/doc/Tcl.n b/doc/Tcl.n index fbe77bc..0f784af 100644 --- a/doc/Tcl.n +++ b/doc/Tcl.n @@ -1,7 +1,6 @@ '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" Copyright (c) 2023 Nathan Coulter '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -17,191 +16,257 @@ Summary of Tcl language syntax. .SH DESCRIPTION .PP The following rules define the syntax and semantics of the Tcl language: -. -.IP "[1] \fBScript.\fR" -A script is composed of zero or more commands delimited by semi-colons or -newlines. -.IP "[2] \fBCommand.\fR" -A command is composed of zero or more words delimited by whitespace. The -replacement for a substitution is included verbatim in the word. For example, a -space in the replacement is included in the word rather than becoming a -delimiter, and \fI\\\\\fR becomes a single backslash in the word. Each word is -processed from left to right and each substitution is performed as soon as it -is complete. -For example, the command -.RS -.PP -.CS -set y [set x 0][incr x][incr x] -.CE -.PP -is composed of three words, and sets the value of \fIy\fR to \fI012\fR. -.PP -If hash -.PQ # -is the first character of what would otherwise be the first word of a command, -all characters up to the next newline are ignored. -.RE -. -.IP "[3] \fBBraced word.\fR" -If a word is enclosed in braces -.PQ { -and -.PQ } "" -, the braces are removed and the enclosed characters become the word. No -substitutions are performed. Nested pairs of braces may occur within the word. -A brace preceded by an odd number of backslashes is not considered part of a -pair, and neither brace nor the backslashes are removed from the word. -. -.IP "[4] \fBQuoted word.\fR" -If a word is enclosed in double quotes +.IP "[1] \fBCommands.\fR" +A Tcl script is a string containing one or more commands. +Semi-colons and newlines are command separators unless quoted as +described below. +Close brackets are command terminators during command substitution +(see below) unless quoted. +.IP "[2] \fBEvaluation.\fR" +A command is evaluated in two steps. +First, the Tcl interpreter breaks the command into \fIwords\fR +and performs substitutions as described below. +These substitutions are performed in the same way for all +commands. +Secondly, the first word is used to locate a routine to +carry out the command, and the remaining words of the command are +passed to that routine. +The routine is free to interpret each of its words +in any way it likes, such as an integer, variable name, list, +or Tcl script. +Different commands interpret their words differently. +.IP "[3] \fBWords.\fR" +Words of a command are separated by white space (except for +newlines, which are command separators). +.IP "[4] \fBDouble quotes.\fR" +If the first character of a word is double-quote .PQ \N'34' -, the double quotes are removed and the enclosed characters become the word. -Substitutions are performed. -. -.IP "[5] \fBList.\fR" -A list has the form of a single command. Newline is whitespace, and semicolon -has no special interpretation. There is no script evaluation so there is no -argument expansion, variable substitution, or command substitution: Dollar-sign -and open bracket have no special interpretation, and what would be argument -expansion in a script is invalid in a list. -. -.IP "[6] \fBArgument expansion.\fR" -If +then the word is terminated by the next double-quote character. +If semi-colons, close brackets, or white space characters +(including newlines) appear between the quotes then they are treated +as ordinary characters and included in the word. +Command substitution, variable substitution, and backslash substitution +are performed on the characters between the quotes as described below. +The double-quotes are not retained as part of the word. +.IP "[5] \fBArgument expansion.\fR" +If a word starts with the string .QW {*} -prefixes a word, it is removed. After any remaining enclosing braces or quotes -are processed and applicable substitutions performed, the word, which must -be a list, is removed from the command, and in its place each word in the -list becomes an additional word in the command. For example, -.CS -cmd a {*}{b [c]} d {*}{$e f {g h}} -.CE +followed by a non-whitespace character, then the leading +.QW {*} +is removed and the rest of the word is parsed and substituted as any other +word. After substitution, the word is parsed as a list (without command or +variable substitutions; backslash substitutions are performed as is normal for +a list and individual internal words may be surrounded by either braces or +double-quote characters), and its words are added to the command being +substituted. For instance, +.QW "cmd a {*}{b [c]} d {*}{$e f {g h}}" is equivalent to -.CS -cmd a b {[c]} d {$e} f {g h} . -.CE -. -.IP "[7] \fBEvaluation.\fR" -To evaluate a script, an interpreter evaluates each successive command. The -first word identifies a procedure, and the remaining words are passed to that -procedure for further evaluation. The procedure interprets each argument in -its own way, e.g. as an integer, variable name, list, mathematical expression, -script, or in some other arbitrary way. The result of the last command is the -result of the script. -. -.IP "[8] \fBCommand substitution.\fR" -Each pair of brackets +.QW "cmd a b {[c]} d {$e} f {g h}" . +.IP "[6] \fBBraces.\fR" +If the first character of a word is an open brace +.PQ { +and rule [5] does not apply, then +the word is terminated by the matching close brace +.PQ } "" . +Braces nest within the word: for each additional open +brace there must be an additional close brace (however, +if an open brace or close brace within the word is +quoted with a backslash then it is not counted in locating the +matching close brace). +No substitutions are performed on the characters between the +braces except for backslash-newline substitutions described +below, nor do semi-colons, newlines, close brackets, +or white space receive any special interpretation. +The word will consist of exactly the characters between the +outer braces, not including the braces themselves. +.IP "[7] \fBCommand substitution.\fR" +If a word contains an open bracket .PQ [ -and -.PQ ] "" -encloses a script and is replaced by the result of that script. -.IP "[9] \fBVariable substitution.\fR" -Each of the following forms begins with dollar sign +then Tcl performs \fIcommand substitution\fR. +To do this it invokes the Tcl interpreter recursively to process +the characters following the open bracket as a Tcl script. +The script may contain any number of commands and must be terminated +by a close bracket +.PQ ] "" . +The result of the script (i.e. the result of its last command) is +substituted into the word in place of the brackets and all of the +characters between them. +There may be any number of command substitutions in a single word. +Command substitution is not performed on words enclosed in braces. +.IP "[8] \fBVariable substitution.\fR" +If a word contains a dollar-sign .PQ $ -and is replaced by the value of the identified variable. \fIname\fR names the -variable and is composed of ASCII letters (\fBA\fR\(en\fBZ\fR and -\fBa\fR\(en\fBz\fR), digits (\fB0\fR\(en\fB9\fR), underscores, or namespace -delimiters (two or more colons). \fIindex\fR is the name of an individual -variable within an array variable, and may be empty. +followed by one of the forms +described below, then Tcl performs \fIvariable +substitution\fR: the dollar-sign and the following characters are +replaced in the word by the value of a variable. +Variable substitution may take any of the following forms: .RS .TP 15 \fB$\fIname\fR . -\fIname\fR may not be empty. +\fIName\fR is the name of a scalar variable; the name is a sequence +of one or more characters that are a letter, digit, underscore, +or namespace separators (two or more colons). +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). .TP 15 \fB$\fIname\fB(\fIindex\fB)\fR . -\fIname\fR may be empty. Substitutions are performed on \fIindex\fR. +\fIName\fR gives the name of an array variable and \fIindex\fR gives +the name of an element within that array. +\fIName\fR must contain only letters, digits, underscores, and +namespace separators, and may be an empty string. +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). +Command substitutions, variable substitutions, and backslash +substitutions are performed on the characters of \fIindex\fR. .TP 15 \fB${\fIname\fB}\fR . -\fIname\fR may be empty. -.TP 15 -\fB${\fIname(index)\fB}\fR -. -\fIname\fR may be empty. No substitutions are performed. +\fIName\fR is the name of a scalar variable or array element. It may contain +any characters whatsoever except for close braces. It indicates an array +element if \fIname\fR is in the form +.QW \fIarrayName\fB(\fIindex\fB)\fR +where \fIarrayName\fR does not contain any open parenthesis characters, +.QW \fB(\fR , +or close brace characters, +.QW \fB}\fR , +and \fIindex\fR can be any sequence of characters except for close brace +characters. No further +substitutions are performed during the parsing of \fIname\fR. +.PP +There may be any number of variable substitutions in a single word. +Variable substitution is not performed on words enclosed in braces. +.PP +Note that variables may contain character sequences other than those listed +above, but in that case other mechanisms must be used to access them (e.g., +via the \fBset\fR command's single-argument form). .RE -Variables that are not accessible through one of the forms above may be -accessed through other mechanisms, e.g. the \fBset\fR command. -.IP "[10] \fBBackslash substitution.\fR" -Each backslash +.IP "[9] \fBBackslash substitution.\fR" +If a backslash .PQ \e -that is not part of one of the forms listed below is removed, and the next -character is included in the word verbatim, which allows the inclusion of -characters that would normally be interpreted, namely whitespace, braces, -brackets, double quote, dollar sign, and backslash. The following sequences -are replaced as described: +appears within a word then \fIbackslash substitution\fR occurs. +In all cases but those described below the backslash is dropped and +the following character is treated as an ordinary +character and included in the word. +This allows characters such as double quotes, close brackets, +and dollar signs to be included in words without triggering +special processing. +The following table lists the backslash sequences that are +handled specially, along with the value that replaces each sequence. .RS .RS .RS .TP 7 \e\fBa\fR -. -Audible alert (bell) (U+7). +Audible alert (bell) (Unicode U+000007). .TP 7 \e\fBb\fR -. -Backspace (U+8). +Backspace (Unicode U+000008). .TP 7 \e\fBf\fR -. -Form feed (U+C). +Form feed (Unicode U+00000C). .TP 7 \e\fBn\fR -. -Newline (U+A). +Newline (Unicode U+00000A). .TP 7 \e\fBr\fR -. -Carriage-return (U+D). +Carriage-return (Unicode U+00000D). .TP 7 \e\fBt\fR -. -Tab (U+9). +Tab (Unicode U+000009). .TP 7 \e\fBv\fR -. -Vertical tab (U+B). +Vertical tab (Unicode U+00000B). .TP 7 \e\fB\fIwhiteSpace\fR . -Newline preceded by an odd number of backslashes, along with the consecutive -spaces and tabs that immediately follow it, is replaced by a single space. -Because this happens before the command is split into words, it occurs even -within braced words, and if the resulting space may subsequently be treated as -a word delimiter. +A single space character replaces the backslash, newline, and all spaces +and tabs after the newline. This backslash sequence is unique in that it +is replaced in a separate pre-pass before the command is actually parsed. +This means that it will be replaced even when it occurs between braces, +and the resulting space will be treated as a word separator if it is not +in braces or quotes. .TP 7 \e\e -. Backslash .PQ \e "" . .TP 7 \e\fIooo\fR . -Up to three octal digits form an eight-bit value for a Unicode character in the -range \fI0\fR\(en\fI377\fR, i.e. U+0\(enU+FF. Only the digits that result in a -number in this range are consumed. +The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal +value for the Unicode character that will be inserted, in the range +\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF). +The parser will stop just before this range overflows, or when +the maximum of three digits is reached. The upper bits of the Unicode +character will be 0. .TP 7 \e\fBx\fIhh\fR . -Up to two hexadecimal digits form an eight-bit value for a Unicode character in -the range \fI0\fR\(en\fIFF\fR. +The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit +hexadecimal value for the Unicode character that will be inserted. The upper +bits of the Unicode character will be 0 (i.e., the character will be in the +range U+000000\(enU+0000FF). .TP 7 \e\fBu\fIhhhh\fR . -Up to four hexadecimal digits form a 16-bit value for a Unicode character in -the range \fI0\fR\(en\fIFFFF\fR. +The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a +sixteen-bit hexadecimal value for the Unicode character that will be +inserted. The upper bits of the Unicode character will be 0 (i.e., the +character will be in the range U+000000\(enU+00FFFF). .TP 7 \e\fBU\fIhhhhhhhh\fR . -Up to eight hexadecimal digits form a 21-bit value for a Unicode character in -the range \fI0\fR\(en\fI10FFFF\fR. Only the digits that result in a number in -this range are consumed. +The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a +twenty-one-bit hexadecimal value for the Unicode character that will be +inserted, in the range U+000000\(enU+10FFFF. The parser will stop just +before this range overflows, or when the maximum of eight digits +is reached. The upper bits of the Unicode character will be 0. .RE .RE .PP +Backslash substitution is not performed on words enclosed in braces, +except for backslash-newline as described above. .RE -. +.IP "[10] \fBComments.\fR" +If a hash character +.PQ # +appears at a point where Tcl is +expecting the first character of the first word of a command, +then the hash character and the characters that follow it, up +through the next newline, are treated as a comment and ignored. +The comment character only has significance when it appears +at the beginning of a command. +.IP "[11] \fBOrder of substitution.\fR" +Each character is processed exactly once by the Tcl interpreter +as part of creating the words of a command. +For example, if variable substitution occurs then no further +substitutions are performed on the value of the variable; the +value is inserted into the word verbatim. +If command substitution occurs then the nested command is +processed entirely by the recursive call to the Tcl interpreter; +no substitutions are performed before making the recursive +call and no additional substitutions are performed on the result +of the nested script. +.RS +.PP +Substitutions take place from left to right, and each substitution is +evaluated completely before attempting to evaluate the next. Thus, a +sequence like +.PP +.CS +set y [set x 0][incr x][incr x] +.CE +.PP +will always set the variable \fIy\fR to the value, \fI012\fR. +.RE +.IP "[12] \fBSubstitution and word boundaries.\fR" +Substitutions do not affect the word boundaries of a command, +except for argument expansion as specified in rule [5]. +For example, during variable substitution the entire value of +the variable becomes part of a single word, even if the variable's +value contains spaces. .SH KEYWORDS backslash, command, comment, script, substitution, variable '\" Local Variables: -- cgit v0.12 From b6b6d5e98a0a5c26e2eed280657ee45b2baae4c9 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 15 May 2024 12:39:53 +0000 Subject: ultimate fix for [79474c58800cdf94]: avoid segfault on copy-state structure freed to early, protected by refCount and by preserving its r/w channels now; back-ported (squashed rewrite) from tclSE to 8.5 base --- generic/tclIO.c | 67 ++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 54 insertions(+), 13 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 807fce1..4260cea 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -107,6 +107,7 @@ typedef struct GetsState { typedef struct CopyState { struct Channel *readPtr; /* Pointer to input channel. */ struct Channel *writePtr; /* Pointer to output channel. */ + int refCount; /* Reference counter. */ int readFlags; /* Original read channel flags. */ int writeFlags; /* Original write channel flags. */ int toRead; /* Number of bytes to copy, or -1. */ @@ -217,6 +218,7 @@ static int StackSetBlockMode(Channel *chanPtr, int mode); static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr, int mode); static void StopCopy(CopyState *csPtr); +static void CopyDecrRefCount(CopyState *csPtr); static void TranslateInputEOL(ChannelState *statePtr, char *dst, const char *src, int *dstLenPtr, int *srcLenPtr); static void UpdateInterest(Channel *chanPtr); @@ -1973,7 +1975,7 @@ Tcl_UnstackChannel( return TCL_ERROR; } - statePtr->csPtrR = csPtrR; + statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; } @@ -3483,8 +3485,14 @@ Tcl_ClearChannelHandlers( * Cancel any pending copy operation. */ - StopCopy(statePtr->csPtrR); - StopCopy(statePtr->csPtrW); + if (statePtr->csPtrR) { + StopCopy(statePtr->csPtrR); + statePtr->csPtrR = NULL; + } + if (statePtr->csPtrW) { + StopCopy(statePtr->csPtrW); + statePtr->csPtrW = NULL; + } /* * Must set the interest mask now to 0, otherwise infinite loops @@ -8630,6 +8638,9 @@ TclCopyChannel( CopyState *csPtr; int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0; + TclChannelPreserve(inChan); + TclChannelPreserve(outChan); + inStatePtr = inPtr->state; outStatePtr = outPtr->state; @@ -8689,6 +8700,7 @@ TclCopyChannel( csPtr->bufSize = inStatePtr->bufSize; csPtr->readPtr = inPtr; csPtr->writePtr = outPtr; + csPtr->refCount = 2; /* two references below (inStatePtr, outStatePtr) */ csPtr->readFlags = readFlags; csPtr->writeFlags = writeFlags; csPtr->toRead = toRead; @@ -8699,7 +8711,7 @@ TclCopyChannel( } csPtr->cmdPtr = cmdPtr; - inStatePtr->csPtrR = csPtr; + inStatePtr->csPtrR = csPtr; outStatePtr->csPtrW = csPtr; /* @@ -8709,7 +8721,7 @@ TclCopyChannel( if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); - return 0; + return TCL_OK; } /* @@ -8752,6 +8764,8 @@ CopyData( /* Encoding control */ int underflow; /* Input underflow */ + csPtr->refCount++; /* avoid freeing during handling */ + inChan = (Tcl_Channel) csPtr->readPtr; outChan = (Tcl_Channel) csPtr->writePtr; inStatePtr = csPtr->readPtr->state; @@ -8863,7 +8877,8 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - return TCL_OK; + result = TCL_OK; + goto done; } } @@ -8954,7 +8969,8 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - return TCL_OK; + result = TCL_OK; + goto done; } /* @@ -8976,7 +8992,8 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - return TCL_OK; + result = TCL_OK; + goto done; } } /* while */ @@ -9027,6 +9044,9 @@ CopyData( } } } + +done: + CopyDecrRefCount(csPtr); return result; } @@ -9130,14 +9150,12 @@ DoRead( code = GetInput(chanPtr); bufPtr = statePtr->inQueueHead; - assert (bufPtr != NULL); - if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) { /* Further reads cannot do any more */ break; } - if (code) { + if (code || !bufPtr) { /* Read error */ UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); @@ -9340,9 +9358,32 @@ StopCopy( CopyEventProc, csPtr); } TclDecrRefCount(csPtr->cmdPtr); + csPtr->cmdPtr = NULL; + } + + if (inStatePtr->csPtrR) { + assert(inStatePtr->csPtrR == csPtr); + inStatePtr->csPtrR = NULL; + CopyDecrRefCount(csPtr); + } + if (outStatePtr->csPtrW) { + assert(outStatePtr->csPtrW == csPtr); + outStatePtr->csPtrW = NULL; + CopyDecrRefCount(csPtr); + } +} + +static void +CopyDecrRefCount( + CopyState *csPtr +) { + if (csPtr->refCount-- > 1) { + return; } - inStatePtr->csPtrR = NULL; - outStatePtr->csPtrW = NULL; + + TclChannelRelease((Tcl_Channel)csPtr->readPtr); + TclChannelRelease((Tcl_Channel)csPtr->writePtr); + ckfree((char *) csPtr); } -- cgit v0.12 From e548c4445745cb73e5505e3aed6541dedab33892 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 15 May 2024 12:46:39 +0000 Subject: test illustrating bug [79474c58800cdf94] (segfaults at end of iocmd-32.3) --- tests/ioCmd.test | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index b8cf52b..2f13904 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -2117,6 +2117,67 @@ test iocmd-32.2 {delete interp of reflected chan} { interp delete child } {} +test iocmd-32.3 {prevent copy-state against segfault by finalize, bug [79474c58800cdf94]} -setup { + proc test_chan {args} { + set rest [lassign $args mode chan] + lappend ::ret $mode + switch -exact $mode { + read {puts $chan "Test" ; close $chan} + finalize {after 20 {set ::done done}} + initialize {return "initialize watch finalize read write"} + } + } + set clchlst {} +} -body { + set ::ret {} + set ch [chan create "read write" test_chan] + lappend clchlst $ch + + lassign [chan pipe] in1 out1 + lappend clchlst $in1 $out1 + lassign [chan pipe] in2 out2 + lappend clchlst $in2 $out2 + lassign [chan pipe] in3 out3 + lappend clchlst $in3 $out3 + + # simulate exec: echo test >@ $out2 2>@ $out3 <@ $in1 &: + fileevent $out2 writable [list apply {{cho che} {puts $cho test; close $cho; close $che}} $out2 $out3] + # recopy to given chans in handler + fileevent $in2 readable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $in readable {} + } + }} $in2 $ch] + fileevent $in3 readable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $in readable {} + } + }} $in3 $ch] + fileevent $out1 writable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $out writable {} + } + }} $ch $out1] + + after 5000 {set ::done tout} + vwait ::done + list {*}$::ret $::done +} -cleanup { + foreach ch $clchlst { + catch {close $ch} + } + unset -nocomplain ::done ::ret ch in1 in2 in3 out1 out2 out3 +} -result {initialize read write finalize done} + # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and ## receiving driver operations to the originator thread. -- cgit v0.12 From 3144d02e6d0c5999a1f603095254dea140f24964 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 15 May 2024 15:06:44 +0000 Subject: small code review: removal of unneeded - result is initially TCL_OK --- generic/tclIO.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 4260cea..31cb48f 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8877,7 +8877,6 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - result = TCL_OK; goto done; } } @@ -8969,7 +8968,6 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - result = TCL_OK; goto done; } @@ -8992,7 +8990,6 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - result = TCL_OK; goto done; } } /* while */ -- cgit v0.12 From 1ca1d9dbccb3f94660bde77b6d9fc36a94bd13cf Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 16 May 2024 08:23:04 +0000 Subject: Tests to illustrate problem found in [36e5517a6850] --- tests/oo.test | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/tests/oo.test b/tests/oo.test index cf8b710..aaea4c2 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -2783,6 +2783,30 @@ test oo-17.14 {OO: instance method unexport (bug 900cb0284bc)} -setup { o destroy c destroy } -result $stdmethods +test oo-17.15 {OO: class method list without -all (bug 36e5517a6850)} -setup { + oo::class create c +} -body { + oo::define c { + method foo {} {} + method Bar {} {} + private method gorp {} {} + } + list [lsort [info class methods c]] [lsort [info class methods c -private]] +} -cleanup { + c destroy +} -result {foo {Bar foo}} +test oo-17.16 {OO: instance method list without -all (bug 36e5517a6850)} -setup { + oo::object create o +} -body { + oo::objdefine o { + method foo {} {} + method Bar {} {} + private method gorp {} {} + } + list [lsort [info object methods o]] [lsort [info object methods o -private]] +} -cleanup { + o destroy +} -result {foo {Bar foo}} test oo-18.1 {OO: define command support} { -- cgit v0.12 From 05ca288b525d93b25136b88a996059bc97de0342 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 16 May 2024 08:44:49 +0000 Subject: Fix the bug; [info class methods -private] regression with TIP 500 --- generic/tclOOInfo.c | 31 +++++++++++++++++++++++++------ 1 file changed, 25 insertions(+), 6 deletions(-) diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 0b9099e..5d27ac9 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -621,9 +621,18 @@ InfoObjectMethodsCmd( Tcl_Free((void *)names); } } else if (oPtr->methodsPtr) { - FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { - if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { - Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + if (scope == -1) { + int scopeFilter = flag | TRUE_PRIVATE_METHOD; + FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { + if (mPtr->typePtr && (mPtr->flags & scopeFilter) == flag) { + Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + } + } + } else { + FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { + if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { + Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + } } } } @@ -1378,9 +1387,19 @@ InfoClassMethodsCmd( } else { FOREACH_HASH_DECLS; - FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { - if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { - Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + if (scope == -1) { + int scopeFilter = flag | TRUE_PRIVATE_METHOD; + + FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { + if (mPtr->typePtr && (mPtr->flags & scopeFilter) == flag) { + Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + } + } + } else { + FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { + if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { + Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + } } } } -- cgit v0.12 From 215645597f4f94533ab6a566d7ed694e8cc355cb Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 16 May 2024 08:49:27 +0000 Subject: test: clean timeout timer --- tests/ioCmd.test | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 2f13904..b341aa8 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -2128,6 +2128,7 @@ test iocmd-32.3 {prevent copy-state against segfault by finalize, bug [79474c588 } } set clchlst {} + set toev {} } -body { set ::ret {} set ch [chan create "read write" test_chan] @@ -2168,14 +2169,15 @@ test iocmd-32.3 {prevent copy-state against segfault by finalize, bug [79474c588 } }} $ch $out1] - after 5000 {set ::done tout} + set toev [after 5000 {set ::done tout}] vwait ::done list {*}$::ret $::done } -cleanup { foreach ch $clchlst { catch {close $ch} } - unset -nocomplain ::done ::ret ch in1 in2 in3 out1 out2 out3 + if {$toev ne ""} { after cancel $toev } + unset -nocomplain ::done ::ret ch in1 in2 in3 out1 out2 out3 toev } -result {initialize read write finalize done} # ### ### ### ######### ######### ######### -- cgit v0.12 From 361c29d154162ab0c0e59710f8411ada520d44cf Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 16 May 2024 08:51:17 +0000 Subject: Add code comments --- generic/tclOOInfo.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 5d27ac9..7435fff 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -622,7 +622,11 @@ InfoObjectMethodsCmd( } } else if (oPtr->methodsPtr) { if (scope == -1) { + /* + * Handle legacy-mode matching. [Bug 36e5517a6850] + */ int scopeFilter = flag | TRUE_PRIVATE_METHOD; + FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { if (mPtr->typePtr && (mPtr->flags & scopeFilter) == flag) { Tcl_ListObjAppendElement(NULL, resultObj, namePtr); @@ -1388,6 +1392,9 @@ InfoClassMethodsCmd( FOREACH_HASH_DECLS; if (scope == -1) { + /* + * Handle legacy-mode matching. [Bug 36e5517a6850] + */ int scopeFilter = flag | TRUE_PRIVATE_METHOD; FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { -- cgit v0.12 From 03cf1c69bbf2cbf952abeef3db7bf2129756e53b Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 16 May 2024 08:56:01 +0000 Subject: code review: preserving r/w channels after all possible failures (don't need to release in error case) --- generic/tclIO.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 31cb48f..80b646b 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8638,9 +8638,6 @@ TclCopyChannel( CopyState *csPtr; int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0; - TclChannelPreserve(inChan); - TclChannelPreserve(outChan); - inStatePtr = inPtr->state; outStatePtr = outPtr->state; @@ -8711,6 +8708,9 @@ TclCopyChannel( } csPtr->cmdPtr = cmdPtr; + TclChannelPreserve(inChan); + TclChannelPreserve(outChan); + inStatePtr->csPtrR = csPtr; outStatePtr->csPtrW = csPtr; -- cgit v0.12 From b42b913a58df34b84c60039a0ce2fbb51a8c6dc9 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 16 May 2024 12:43:52 +0000 Subject: A couple of tiny code style improvements --- generic/tclIO.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index d4c52a7..2df8696 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -9559,7 +9559,7 @@ CopyData( /* Encoding control */ int underflow; /* Input underflow */ - csPtr->refCount++; /* avoid freeing during handling */ + csPtr->refCount++; /* avoid freeing during handling */ inChan = (Tcl_Channel) csPtr->readPtr; outChan = (Tcl_Channel) csPtr->writePtr; @@ -9847,7 +9847,7 @@ CopyData( } } -done: + done: CopyDecrRefCount(csPtr); return result; } @@ -10202,8 +10202,8 @@ StopCopy( static void CopyDecrRefCount( - CopyState *csPtr -) { + CopyState *csPtr) +{ if (csPtr->refCount-- > 1) { return; } -- cgit v0.12 From 934d0090c2d9faa72ce1daac38077ee7932ce8b1 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 16 May 2024 15:38:08 +0000 Subject: Test that hits [87271f7cd6] reasonably precisely --- tests/oo.test | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/tests/oo.test b/tests/oo.test index abd5d31..fa2adf8 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -3296,6 +3296,46 @@ test oo-22.2 {OO and info frame: Bug 3001438} -setup { } -match glob -cleanup { c destroy } -result {* cmd {info frame 0} method test class ::c level 0} +test oo-22.3 {OO and coroutines and info frame} -setup { + oo::class create A { + self method run {nworkers} { + set ::result {} + set workers {} + for {set n 1} {$n <= $nworkers} {incr n} { + set worker [A create a$n] + lappend workers $worker + $worker schedule + } + after 250 [namespace code {variable forever false}] + variable forever true + vwait [my varname forever] + foreach worker $workers { + $worker destroy + } + return $::result + } + method schedule {} { + set coro coro-[namespace tail [self]] + if {[llength [info commands $coro]] == 0} { + coroutine $coro my Work + } + } + method Work {} { + after 0 [info coroutine] + yield + lappend ::result [dump] + } + } +} -body { + # Triggers a crash with incorrectly restored procPtr->cmdPtr + proc dump {} { + info frame [expr {[info frame] - 1}] + } + A run 2 +} -cleanup { + catch {rename dump {}} + catch {A destroy} +} -match glob -result {{* method Work object *} {* method Work object *}} # Prove that the issue in [Bug 1865054] isn't an issue any more test oo-23.1 {Self-like derivation; complex case!} -setup { -- cgit v0.12 From 6b40067413c58b574f984a0974769a79f7097174 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 16 May 2024 15:43:21 +0000 Subject: Make sure we're looking for the right results --- tests/oo.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/oo.test b/tests/oo.test index fa2adf8..38fb276 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -3335,7 +3335,7 @@ test oo-22.3 {OO and coroutines and info frame} -setup { } -cleanup { catch {rename dump {}} catch {A destroy} -} -match glob -result {{* method Work object *} {* method Work object *}} +} -match glob -result {{* method Work class ::A *} {* method Work class ::A *}} # Prove that the issue in [Bug 1865054] isn't an issue any more test oo-23.1 {Self-like derivation; complex case!} -setup { -- cgit v0.12 From b542f7763dcd77ea5d1ca47537f4e4aee110b71d Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 16 May 2024 15:51:42 +0000 Subject: Apply an emergency workaround --- generic/tclCmdIL.c | 7 ++++++- tests/oo.test | 3 ++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index aef0399..279bc7b 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1388,7 +1388,12 @@ TclInfoFrame( * Procedure CallFrame. */ - if (procPtr != NULL) { + if (procPtr != NULL +#ifndef AVOID_EMERGENCY_HACKS + /* Emergency band-aid fix for [87271f7cd6] */ + && procPtr->cmdPtr != NULL +#endif + ) { Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr; if (namePtr) { diff --git a/tests/oo.test b/tests/oo.test index 38fb276..7266255 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -3296,7 +3296,8 @@ test oo-22.2 {OO and info frame: Bug 3001438} -setup { } -match glob -cleanup { c destroy } -result {* cmd {info frame 0} method test class ::c level 0} -test oo-22.3 {OO and coroutines and info frame} -setup { +# BUG: second call is missing info (caused by workaround in tclCmdIL.c) +test oo-22.3 {OO and coroutines and info frame} -constraints knownBug -setup { oo::class create A { self method run {nworkers} { set ::result {} -- cgit v0.12 From 48e5573a790af82c0fdb087b42883536157739d4 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 16 May 2024 20:28:04 +0000 Subject: fix mem-leak originating by cyclic reference `rcPtr->name (type "channel", its refCount may be larger than 1) => statPtr => chanPtr => chanPtr->instanceData => refChan`: this would avoid that object rcPtr->name (name of channel that gets deleted or dead) still holds the reference to statPtr, see 2nd part of bug [79474c58800cdf94]. --- generic/tclIORChan.c | 41 ++++++++++++++++++++++------------------- tests/ioCmd.test | 2 +- 2 files changed, 23 insertions(+), 20 deletions(-) diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 727239b..f2bb186 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -2211,23 +2211,37 @@ NextHandle(void) return resObj; } -static void -FreeReflectedChannel( - char *blockPtr) +static inline void +CleanRefChannelInstance( + ReflectedChannel *rcPtr) { - ReflectedChannel *rcPtr = (ReflectedChannel *) blockPtr; - Channel *chanPtr = (Channel *) rcPtr->chan; - - TclChannelRelease((Tcl_Channel)chanPtr); if (rcPtr->name) { + /* + * Reset obj-type (channel is deleted or dead anyway) to avoid leakage + * by cyclic references (see bug [79474c58800cdf94]). + */ + TclFreeIntRep(rcPtr->name); Tcl_DecrRefCount(rcPtr->name); + rcPtr->name = NULL; } if (rcPtr->methods) { Tcl_DecrRefCount(rcPtr->methods); + rcPtr->methods = NULL; } if (rcPtr->cmd) { Tcl_DecrRefCount(rcPtr->cmd); + rcPtr->cmd = NULL; } +} +static void +FreeReflectedChannel( + char *blockPtr) +{ + ReflectedChannel *rcPtr = (ReflectedChannel *) blockPtr; + Channel *chanPtr = (Channel *) rcPtr->chan; + + TclChannelRelease((Tcl_Channel)chanPtr); + CleanRefChannelInstance(rcPtr); ckfree(rcPtr); } @@ -2497,18 +2511,7 @@ MarkDead( if (rcPtr->dead) { return; } - if (rcPtr->name) { - Tcl_DecrRefCount(rcPtr->name); - rcPtr->name = NULL; - } - if (rcPtr->methods) { - Tcl_DecrRefCount(rcPtr->methods); - rcPtr->methods = NULL; - } - if (rcPtr->cmd) { - Tcl_DecrRefCount(rcPtr->cmd); - rcPtr->cmd = NULL; - } + CleanRefChannelInstance(rcPtr); rcPtr->dead = 1; } diff --git a/tests/ioCmd.test b/tests/ioCmd.test index b341aa8..3dbb3cc 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -2177,7 +2177,7 @@ test iocmd-32.3 {prevent copy-state against segfault by finalize, bug [79474c588 catch {close $ch} } if {$toev ne ""} { after cancel $toev } - unset -nocomplain ::done ::ret ch in1 in2 in3 out1 out2 out3 toev + unset -nocomplain ::done ::ret ch in1 in2 in3 out1 out2 out3 toev clchlst } -result {initialize read write finalize done} # ### ### ### ######### ######### ######### -- cgit v0.12 From bf60694206df4d1442616647b588707dfab94122 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 17 May 2024 09:51:41 +0000 Subject: fixes yet another segfault (if write handler doesn't generate an error, but returns normally with length of written bytes) --- generic/tclIO.c | 17 +++++++++-------- tests/ioCmd.test | 1 + 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 2df8696..c3844af 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -9964,19 +9964,20 @@ DoRead( } if (code || !bufPtr) { - /* - * Read error - */ - - UpdateInterest(chanPtr); - TclChannelRelease((Tcl_Channel)chanPtr); - return -1; + /* Read error (or channel dead/closed) */ + goto readErr; } assert(IsBufferFull(bufPtr)); } - assert(bufPtr != NULL); + if (!bufPtr) { + readErr: + + UpdateInterest(chanPtr); + TclChannelRelease((Tcl_Channel)chanPtr); + return -1; + } bytesRead = BytesLeft(bufPtr); bytesWritten = bytesToRead; diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 3dbb3cc..e56260b 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -2123,6 +2123,7 @@ test iocmd-32.3 {prevent copy-state against segfault by finalize, bug [79474c588 lappend ::ret $mode switch -exact $mode { read {puts $chan "Test" ; close $chan} + write {set data [lindex $rest 0]; string length $data} finalize {after 20 {set ::done done}} initialize {return "initialize watch finalize read write"} } -- cgit v0.12 From 547369ee887f3d306aaf58c719596c22f2eb8db3 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 17 May 2024 10:14:01 +0000 Subject: extend test to cover both variants (without and with error in reflected write handler) --- tests/ioCmd.test | 95 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 50 insertions(+), 45 deletions(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index e56260b..a2061fa 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -2118,68 +2118,73 @@ test iocmd-32.2 {delete interp of reflected chan} { } {} test iocmd-32.3 {prevent copy-state against segfault by finalize, bug [79474c58800cdf94]} -setup { - proc test_chan {args} { + proc test_chan {writeErr args} { set rest [lassign $args mode chan] lappend ::ret $mode switch -exact $mode { read {puts $chan "Test" ; close $chan} - write {set data [lindex $rest 0]; string length $data} + write {if {$writeErr} {return}; set data [lindex $rest 0]; string length $data} finalize {after 20 {set ::done done}} initialize {return "initialize watch finalize read write"} } } set clchlst {} - set toev {} + set toev [after 5000 {set ::done tout}] } -body { set ::ret {} - set ch [chan create "read write" test_chan] - lappend clchlst $ch - - lassign [chan pipe] in1 out1 - lappend clchlst $in1 $out1 - lassign [chan pipe] in2 out2 - lappend clchlst $in2 $out2 - lassign [chan pipe] in3 out3 - lappend clchlst $in3 $out3 - - # simulate exec: echo test >@ $out2 2>@ $out3 <@ $in1 &: - fileevent $out2 writable [list apply {{cho che} {puts $cho test; close $cho; close $che}} $out2 $out3] - # recopy to given chans in handler - fileevent $in2 readable [list apply {{in out} { - if {[catch { - chan copy $in $out - } msg]} { - #puts err:$msg - fileevent $in readable {} - } - }} $in2 $ch] - fileevent $in3 readable [list apply {{in out} { - if {[catch { - chan copy $in $out - } msg]} { - #puts err:$msg - fileevent $in readable {} - } - }} $in3 $ch] - fileevent $out1 writable [list apply {{in out} { - if {[catch { - chan copy $in $out - } msg]} { - #puts err:$msg - fileevent $out writable {} - } - }} $ch $out1] + # 1st attempt without error in write, another with error in write: + foreach i {0 1} { + set ch [chan create "read write" [list test_chan $i]] + lappend clchlst $ch + + lassign [chan pipe] in1 out1 + lappend clchlst $in1 $out1 + lassign [chan pipe] in2 out2 + lappend clchlst $in2 $out2 + lassign [chan pipe] in3 out3 + lappend clchlst $in3 $out3 + + # simulate exec: echo test >@ $out2 2>@ $out3 <@ $in1 &: + fileevent $out2 writable [list apply {{cho che} { + puts $cho test; close $cho; close $che + }} $out2 $out3] + # recopy to given chans in handler + fileevent $in2 readable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $in readable {} + } + }} $in2 $ch] + fileevent $in3 readable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $in readable {} + } + }} $in3 $ch] + fileevent $out1 writable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $out writable {} + } + }} $ch $out1] - set toev [after 5000 {set ::done tout}] - vwait ::done - list {*}$::ret $::done + vwait ::done + lappend ::ret $::done + } + set ::ret } -cleanup { foreach ch $clchlst { catch {close $ch} } - if {$toev ne ""} { after cancel $toev } + after cancel $toev unset -nocomplain ::done ::ret ch in1 in2 in3 out1 out2 out3 toev clchlst -} -result {initialize read write finalize done} +} -result [lrepeat 2 initialize read write finalize done] # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and -- cgit v0.12 From 5e5e6ab89d9929e25b0f7a27935db4172ed85ed9 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 17 May 2024 11:11:31 +0000 Subject: Starting to clean up the mess. The extra frame info can have the same lifespan as the method itself. --- generic/tclOOInt.h | 9 ++++ generic/tclOOMethod.c | 136 ++++++++++++++++++++++++++++++-------------------- tests/oo.test | 49 ++++++++++-------- 3 files changed, 120 insertions(+), 74 deletions(-) diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 2931044..e7d727a 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -97,6 +97,15 @@ typedef struct ProcedureMethod { GetFrameInfoValueProc *gfivProc; /* Callback to allow for fine tuning of how * the method reports itself. */ + ExtraFrameInfo efi; /* Space used to store data for [info frame] */ + Tcl_Interp *interp; /* Interpreter in which to compute the name of + * the method. */ + Tcl_Method method; /* Method to compute the name of. */ + int callSiteFlags; /* Flags from the call chain. Only interested + * in whether this is a constructor or + * destructor, which we can't know until then + * for messy reasons. Other flags are variable + * but not used. */ } ProcedureMethod; #define TCLOO_PROCEDURE_METHOD_VERSION 0 diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index edaa593..1347aa5 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -17,17 +17,6 @@ #include "tclCompile.h" /* - * Structure used to help delay computing names of objects or classes for - * [info frame] until needed, making invocation faster in the normal case. - */ - -struct PNI { - Tcl_Interp *interp; /* Interpreter in which to compute the name of - * a method. */ - Tcl_Method method; /* Method to compute the name of. */ -}; - -/* * Structure used to contain all the information needed about a call frame * used in a procedure-like method. */ @@ -38,11 +27,8 @@ typedef struct { ProcErrorProc *errProc; /* The error handler for the body. */ Tcl_Obj *nameObj; /* The "name" of the command. */ Command cmd; /* The command structure. Mostly bogus. */ - ExtraFrameInfo efi; /* Extra information used for [info frame]. */ Command *oldCmdPtr; /* Saved cmdPtr so that we can be safe after a * recursive call returns. */ - struct PNI pni; /* Specialist information used in the efi - * field for this type of call. */ } PMFrameData; /* @@ -86,6 +72,9 @@ static void ConstructorErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void DestructorErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); +static inline void InitFrameInfo(Tcl_Interp *interp, + ProcedureMethod *pmPtr, Tcl_ObjectContext context); +static Tcl_Obj * RenderMethodName(void *clientData); static Tcl_Obj * RenderDeclarerName(void *clientData); static int InvokeForwardMethod(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, @@ -658,7 +647,7 @@ TclOOMakeProcMethod( static int InvokeProcedureMethod( - void *clientData, /* Pointer to some per-method context. */ + void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ @@ -682,6 +671,8 @@ InvokeProcedureMethod( Tcl_ObjectContextSkippedArgs(context)); } + InitFrameInfo(interp, pmPtr, context); + /* * Allocate the special frame data. */ @@ -737,6 +728,48 @@ InvokeProcedureMethod( Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc); } +/* + * Finishes filling out the extra frame info so that [info frame] works. + */ +static inline void +InitFrameInfo( + Tcl_Interp *interp, /* For object name resolution later. */ + ProcedureMethod *pmPtr, /* What we're writing to. */ + Tcl_ObjectContext context) /* The calling context, used to figure out how + * we're using the method. */ +{ + Tcl_Method method = Tcl_ObjectContextMethod(context); + + if (pmPtr->efi.length) { + /* + * Do nothing if already set up. + */ + return; + } + + pmPtr->efi.length = 2; + pmPtr->efi.fields[0].name = "method"; + pmPtr->efi.fields[0].proc = RenderMethodName; + pmPtr->efi.fields[0].clientData = pmPtr; + pmPtr->callSiteFlags = ((CallContext *) + context)->callPtr->flags & (CONSTRUCTOR | DESTRUCTOR); + pmPtr->interp = interp; + pmPtr->method = method; + if (pmPtr->gfivProc != NULL) { + pmPtr->efi.fields[1].name = ""; + pmPtr->efi.fields[1].proc = pmPtr->gfivProc; + pmPtr->efi.fields[1].clientData = pmPtr; + } else { + if (Tcl_MethodDeclarerObject(method) != NULL) { + pmPtr->efi.fields[1].name = "object"; + } else { + pmPtr->efi.fields[1].name = "class"; + } + pmPtr->efi.fields[1].proc = RenderDeclarerName; + pmPtr->efi.fields[1].clientData = pmPtr; + } +} + static int FinalizePMCall( void *data[], @@ -791,7 +824,6 @@ PushMethodCallFrame( { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; int result; - const char *namePtr; CallFrame **framePtrPtr = &fdPtr->framePtr; /* @@ -799,17 +831,14 @@ PushMethodCallFrame( */ if (contextPtr->callPtr->flags & CONSTRUCTOR) { - namePtr = ""; fdPtr->nameObj = contextPtr->oPtr->fPtr->constructorName; fdPtr->errProc = ConstructorErrorHandler; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { - namePtr = ""; fdPtr->nameObj = contextPtr->oPtr->fPtr->destructorName; fdPtr->errProc = DestructorErrorHandler; } else { fdPtr->nameObj = Tcl_MethodName( Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr)); - namePtr = TclGetString(fdPtr->nameObj); fdPtr->errProc = MethodErrorHandler; } if (pmPtr->errProc != NULL) { @@ -822,8 +851,7 @@ PushMethodCallFrame( */ if (pmPtr->flags & USE_DECLARER_NS) { - Method *mPtr = - contextPtr->callPtr->chain[contextPtr->index].mPtr; + Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; if (mPtr->declaringClassPtr != NULL) { nsPtr = (Namespace *) @@ -845,10 +873,9 @@ PushMethodCallFrame( * Compile the body. This operation may fail. */ - fdPtr->efi.length = 2; memset(&fdPtr->cmd, 0, sizeof(Command)); fdPtr->cmd.nsPtr = nsPtr; - fdPtr->cmd.clientData = &fdPtr->efi; + fdPtr->cmd.clientData = &pmPtr->efi; pmPtr->procPtr->cmdPtr = &fdPtr->cmd; /* @@ -865,7 +892,8 @@ PushMethodCallFrame( codePtr->nsPtr = nsPtr; } result = TclProcCompileProc(interp, pmPtr->procPtr, - pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr); + pmPtr->procPtr->bodyPtr, nsPtr, "body of method", + TclGetString(fdPtr->nameObj)); if (result != TCL_OK) { goto failureReturn; } @@ -883,32 +911,6 @@ PushMethodCallFrame( fdPtr->framePtr->objv = objv; fdPtr->framePtr->procPtr = pmPtr->procPtr; - /* - * Finish filling out the extra frame info so that [info frame] works. - */ - - fdPtr->efi.fields[0].name = "method"; - 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"; - } - fdPtr->efi.fields[1].proc = RenderDeclarerName; - fdPtr->efi.fields[1].clientData = &fdPtr->pni; - fdPtr->pni.interp = interp; - fdPtr->pni.method = method; - } - return TCL_OK; /* @@ -1115,6 +1117,32 @@ ProcedureMethodCompiledVarResolver( /* * ---------------------------------------------------------------------- * + * RenderMethodName -- + * + * Returns the name of the declared method. Used for producing information + * for [info frame]. + * + * ---------------------------------------------------------------------- + */ + +static Tcl_Obj * +RenderMethodName( + void *clientData) +{ + ProcedureMethod *pmPtr = (ProcedureMethod *) clientData; + + if (pmPtr->callSiteFlags & CONSTRUCTOR) { + return TclOOGetFoundation(pmPtr->interp)->constructorName; + } else if (pmPtr->callSiteFlags & DESTRUCTOR) { + return TclOOGetFoundation(pmPtr->interp)->destructorName; + } else { + return Tcl_MethodName(pmPtr->method); + } +} + +/* + * ---------------------------------------------------------------------- + * * RenderDeclarerName -- * * Returns the name of the entity (object or class) which declared a @@ -1129,13 +1157,13 @@ static Tcl_Obj * RenderDeclarerName( void *clientData) { - struct PNI *pni = (struct PNI *)clientData; - Tcl_Object object = Tcl_MethodDeclarerObject(pni->method); + ProcedureMethod *pmPtr = (ProcedureMethod *) clientData; + Tcl_Object object = Tcl_MethodDeclarerObject(pmPtr->method); if (object == NULL) { - object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method)); + object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pmPtr->method)); } - return TclOOObjectName(pni->interp, (Object *) object); + return TclOOObjectName(pmPtr->interp, (Object *) object); } /* diff --git a/tests/oo.test b/tests/oo.test index 7266255..8bc6363 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -3296,40 +3296,49 @@ test oo-22.2 {OO and info frame: Bug 3001438} -setup { } -match glob -cleanup { c destroy } -result {* cmd {info frame 0} method test class ::c level 0} -# BUG: second call is missing info (caused by workaround in tclCmdIL.c) test oo-22.3 {OO and coroutines and info frame} -constraints knownBug -setup { oo::class create A { - self method run {nworkers} { - set ::result {} - set workers {} - for {set n 1} {$n <= $nworkers} {incr n} { - set worker [A create a$n] - lappend workers $worker - $worker schedule + self { + variable result stop + method WithWorkers {nworkers args script} { + set workers {} + try { + for {set n 1} {$n <= $nworkers} {incr n} { + lappend workers [set worker [[self] new]] + $worker schedule {*}$args + } + return [uplevel 1 $script] + } finally { + foreach worker $workers {$worker destroy} + } } - after 250 [namespace code {variable forever false}] - variable forever true - vwait [my varname forever] - foreach worker $workers { - $worker destroy + method run {nworkers} { + set result {} + set stopvar [my varname stop] + set stop false + my WithWorkers $nworkers [list my Work [my varname result]] { + after idle [namespace code {set stop true}] + vwait $stopvar + } + return $result } - return $::result } - method schedule {} { - set coro coro-[namespace tail [self]] - if {[llength [info commands $coro]] == 0} { - coroutine $coro my Work + method schedule {args} { + set coro [namespace current]::coro + if {![llength [info commands $coro]]} { + coroutine $coro {*}$args } } - method Work {} { + method Work {var} { after 0 [info coroutine] yield - lappend ::result [dump] + lappend $var [dump] } } } -body { # Triggers a crash with incorrectly restored procPtr->cmdPtr proc dump {} { + # Called from [A Work] after a coroutine suspend/resume info frame [expr {[info frame] - 1}] } A run 2 -- cgit v0.12 From 34edafeda77ffaa24279ae1d0343181a091a484d Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 17 May 2024 11:48:53 +0000 Subject: Free ChannelState.chanMsg .unreportedMsg --- generic/tclIO.c | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 2df8696..adcf513 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -157,7 +157,8 @@ typedef struct CloseCallback { static ChannelBuffer * AllocChannelBuffer(int length); static void PreserveChannelBuffer(ChannelBuffer *bufPtr); static void ReleaseChannelBuffer(ChannelBuffer *bufPtr); -static int IsShared(ChannelBuffer *bufPtr); +static void FreeChannelState(char *blockPtr); +static int IsShared(ChannelBuffer *bufPtr); static void ChannelFree(Channel *chanPtr); static void ChannelTimerProc(void *clientData); static int ChanRead(Channel *chanPtr, char *dst, int dstSize); @@ -2949,6 +2950,23 @@ FlushChannel( return errorCode; } +static void FreeChannelState(char *blockPtr) +{ + ChannelState *statePtr = (ChannelState *)blockPtr; + /* + * Bug [79474c588] leak. Possible other fields need freeing but + * not clear if they are already freed and if the fields are set to NULL + * when they are. Test suite shows no other leaks at the moment. + */ + if (statePtr->chanMsg) { + Tcl_DecrRefCount(statePtr->chanMsg); + } + if (statePtr->unreportedMsg) { + Tcl_DecrRefCount(statePtr->unreportedMsg); + } + ckfree(statePtr); +} + /* *---------------------------------------------------------------------- * @@ -3125,7 +3143,7 @@ CloseChannel( ChannelFree(chanPtr); - Tcl_EventuallyFree(statePtr, TCL_DYNAMIC); + Tcl_EventuallyFree(statePtr, FreeChannelState); return errorCode; } -- cgit v0.12 From 8c0b8c33474037d60cf844dd79f2ce0d2dc344ea Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 17 May 2024 13:21:47 +0000 Subject: split iocmd-32.3 in two tests (move cycle outside of the test) --- tests/ioCmd.test | 97 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 48 insertions(+), 49 deletions(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index a2061fa..74fabe7 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -2117,13 +2117,15 @@ test iocmd-32.2 {delete interp of reflected chan} { interp delete child } {} -test iocmd-32.3 {prevent copy-state against segfault by finalize, bug [79474c58800cdf94]} -setup { - proc test_chan {writeErr args} { +# 1st attempt without error in write, another with error in write: +foreach ::writeErr {0 1} { +test iocmd-32.3.$::writeErr {prevent copy-state against segfault by finalize, bug [79474c58800cdf94]} -setup { + proc test_chan {args} { set rest [lassign $args mode chan] lappend ::ret $mode switch -exact $mode { read {puts $chan "Test" ; close $chan} - write {if {$writeErr} {return}; set data [lindex $rest 0]; string length $data} + write {if {$::writeErr} {return "boom"}; set data [lindex $rest 0]; string length $data} finalize {after 20 {set ::done done}} initialize {return "initialize watch finalize read write"} } @@ -2132,59 +2134,56 @@ test iocmd-32.3 {prevent copy-state against segfault by finalize, bug [79474c588 set toev [after 5000 {set ::done tout}] } -body { set ::ret {} - # 1st attempt without error in write, another with error in write: - foreach i {0 1} { - set ch [chan create "read write" [list test_chan $i]] - lappend clchlst $ch - - lassign [chan pipe] in1 out1 - lappend clchlst $in1 $out1 - lassign [chan pipe] in2 out2 - lappend clchlst $in2 $out2 - lassign [chan pipe] in3 out3 - lappend clchlst $in3 $out3 - - # simulate exec: echo test >@ $out2 2>@ $out3 <@ $in1 &: - fileevent $out2 writable [list apply {{cho che} { - puts $cho test; close $cho; close $che - }} $out2 $out3] - # recopy to given chans in handler - fileevent $in2 readable [list apply {{in out} { - if {[catch { - chan copy $in $out - } msg]} { - #puts err:$msg - fileevent $in readable {} - } - }} $in2 $ch] - fileevent $in3 readable [list apply {{in out} { - if {[catch { - chan copy $in $out - } msg]} { - #puts err:$msg - fileevent $in readable {} - } - }} $in3 $ch] - fileevent $out1 writable [list apply {{in out} { - if {[catch { - chan copy $in $out - } msg]} { - #puts err:$msg - fileevent $out writable {} - } - }} $ch $out1] + set ch [chan create "read write" test_chan] + lappend clchlst $ch + + lassign [chan pipe] in1 out1 + lappend clchlst $in1 $out1 + lassign [chan pipe] in2 out2 + lappend clchlst $in2 $out2 + lassign [chan pipe] in3 out3 + lappend clchlst $in3 $out3 + + # simulate exec: echo test >@ $out2 2>@ $out3 <@ $in1 &: + fileevent $out2 writable [list apply {{cho che} { + puts $cho test; close $cho; close $che + }} $out2 $out3] + # recopy to given chans in handler + fileevent $in2 readable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $in readable {} + } + }} $in2 $ch] + fileevent $in3 readable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $in readable {} + } + }} $in3 $ch] + fileevent $out1 writable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $out writable {} + } + }} $ch $out1] - vwait ::done - lappend ::ret $::done - } - set ::ret + vwait ::done + lappend ::ret $::done } -cleanup { foreach ch $clchlst { catch {close $ch} } after cancel $toev unset -nocomplain ::done ::ret ch in1 in2 in3 out1 out2 out3 toev clchlst -} -result [lrepeat 2 initialize read write finalize done] +} -result {initialize read write finalize done} +}; unset ::writeErr # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and -- cgit v0.12 From 4d361a9367164a02b89f6ff54111cd46c9b622cc Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 17 May 2024 13:28:51 +0000 Subject: Fix the problem properly --- generic/tclOOInt.h | 1 + generic/tclOOMethod.c | 158 ++++++++++++++++++-------------------------------- tests/oo.test | 137 +++++++++++++++++++++++++++++++------------ 3 files changed, 157 insertions(+), 139 deletions(-) diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index e7d727a..41c674c 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -97,6 +97,7 @@ typedef struct ProcedureMethod { GetFrameInfoValueProc *gfivProc; /* Callback to allow for fine tuning of how * the method reports itself. */ + Command cmd; /* Space used to connect to [info frame] */ ExtraFrameInfo efi; /* Space used to store data for [info frame] */ Tcl_Interp *interp; /* Interpreter in which to compute the name of * the method. */ diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 1347aa5..5cff201 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -25,10 +25,8 @@ typedef struct { CallFrame *framePtr; /* Reference to the call frame itself (it's * actually allocated on the Tcl stack). */ ProcErrorProc *errProc; /* The error handler for the body. */ - Tcl_Obj *nameObj; /* The "name" of the command. */ - Command cmd; /* The command structure. Mostly bogus. */ - Command *oldCmdPtr; /* Saved cmdPtr so that we can be safe after a - * recursive call returns. */ + Tcl_Obj *nameObj; /* The "name" of the command. Only used for a + * few moments, so not reference. */ } PMFrameData; /* @@ -72,8 +70,6 @@ static void ConstructorErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void DestructorErrorHandler(Tcl_Interp *interp, Tcl_Obj *procNameObj); -static inline void InitFrameInfo(Tcl_Interp *interp, - ProcedureMethod *pmPtr, Tcl_ObjectContext context); static Tcl_Obj * RenderMethodName(void *clientData); static Tcl_Obj * RenderDeclarerName(void *clientData); static int InvokeForwardMethod(void *clientData, @@ -111,6 +107,20 @@ static const Tcl_MethodType fwdMethodType = { ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable)) #define TclVarHashGetValue(hPtr) \ ((Tcl_Var) ((char *)hPtr - TclOffset(VarInHash, entry))) + +static inline ProcedureMethod * +AllocProcedureMethodRecord( + int flags) +{ + ProcedureMethod *pmPtr = (ProcedureMethod *) + ckalloc(sizeof(ProcedureMethod)); + memset(pmPtr, 0, sizeof(ProcedureMethod)); + pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; + pmPtr->flags = flags & USE_DECLARER_NS; + pmPtr->refCount = 1; + pmPtr->cmd.clientData = &pmPtr->efi; + return pmPtr; +} /* * ---------------------------------------------------------------------- @@ -331,12 +341,7 @@ TclOONewProcInstanceMethod( if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } - pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); - memset(pmPtr, 0, sizeof(ProcedureMethod)); - pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; - pmPtr->flags = flags & USE_DECLARER_NS; - pmPtr->refCount = 1; - + pmPtr = AllocProcedureMethodRecord(flags); method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); if (method == NULL) { @@ -392,12 +397,7 @@ TclOONewProcMethod( procName = (nameObj==NULL ? "" : TclGetString(nameObj)); } - pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); - memset(pmPtr, 0, sizeof(ProcedureMethod)); - pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; - pmPtr->flags = flags & USE_DECLARER_NS; - pmPtr->refCount = 1; - + pmPtr = AllocProcedureMethodRecord(flags); method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); @@ -671,7 +671,36 @@ InvokeProcedureMethod( Tcl_ObjectContextSkippedArgs(context)); } - InitFrameInfo(interp, pmPtr, context); + /* + * Finishes filling out the extra frame info so that [info frame] works if + * that is not already set up. + */ + + if (pmPtr->efi.length == 0) { + Tcl_Method method = Tcl_ObjectContextMethod(context); + + pmPtr->efi.length = 2; + pmPtr->efi.fields[0].name = "method"; + pmPtr->efi.fields[0].proc = RenderMethodName; + pmPtr->efi.fields[0].clientData = pmPtr; + pmPtr->callSiteFlags = ((CallContext *) + context)->callPtr->flags & (CONSTRUCTOR | DESTRUCTOR); + pmPtr->interp = interp; + pmPtr->method = method; + if (pmPtr->gfivProc != NULL) { + pmPtr->efi.fields[1].name = ""; + pmPtr->efi.fields[1].proc = pmPtr->gfivProc; + pmPtr->efi.fields[1].clientData = pmPtr; + } else { + if (Tcl_MethodDeclarerObject(method) != NULL) { + pmPtr->efi.fields[1].name = "object"; + } else { + pmPtr->efi.fields[1].name = "class"; + } + pmPtr->efi.fields[1].proc = RenderDeclarerName; + pmPtr->efi.fields[1].clientData = pmPtr; + } + } /* * Allocate the special frame data. @@ -702,13 +731,6 @@ InvokeProcedureMethod( result = pmPtr->preCallProc(pmPtr->clientData, interp, context, (Tcl_CallFrame *) fdPtr->framePtr, &isFinished); if (isFinished || result != TCL_OK) { - /* - * Restore the old cmdPtr so that a subsequent use of [info frame] - * won't crash on us. [Bug 3001438] - */ - - pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; - Tcl_PopCallFrame(interp); TclStackFree(interp, fdPtr->framePtr); if (pmPtr->refCount-- <= 1) { @@ -728,48 +750,6 @@ InvokeProcedureMethod( Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc); } -/* - * Finishes filling out the extra frame info so that [info frame] works. - */ -static inline void -InitFrameInfo( - Tcl_Interp *interp, /* For object name resolution later. */ - ProcedureMethod *pmPtr, /* What we're writing to. */ - Tcl_ObjectContext context) /* The calling context, used to figure out how - * we're using the method. */ -{ - Tcl_Method method = Tcl_ObjectContextMethod(context); - - if (pmPtr->efi.length) { - /* - * Do nothing if already set up. - */ - return; - } - - pmPtr->efi.length = 2; - pmPtr->efi.fields[0].name = "method"; - pmPtr->efi.fields[0].proc = RenderMethodName; - pmPtr->efi.fields[0].clientData = pmPtr; - pmPtr->callSiteFlags = ((CallContext *) - context)->callPtr->flags & (CONSTRUCTOR | DESTRUCTOR); - pmPtr->interp = interp; - pmPtr->method = method; - if (pmPtr->gfivProc != NULL) { - pmPtr->efi.fields[1].name = ""; - pmPtr->efi.fields[1].proc = pmPtr->gfivProc; - pmPtr->efi.fields[1].clientData = pmPtr; - } else { - if (Tcl_MethodDeclarerObject(method) != NULL) { - pmPtr->efi.fields[1].name = "object"; - } else { - pmPtr->efi.fields[1].name = "class"; - } - pmPtr->efi.fields[1].proc = RenderDeclarerName; - pmPtr->efi.fields[1].clientData = pmPtr; - } -} - static int FinalizePMCall( void *data[], @@ -792,13 +772,6 @@ FinalizePMCall( } /* - * Restore the old cmdPtr so that a subsequent use of [info frame] won't - * crash on us. [Bug 3001438] - */ - - pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; - - /* * Scrap the special frame data now that we're done with it. Note that we * are inlining DeleteProcedureMethod() here; this location is highly * sensitive when it comes to performance! @@ -862,29 +835,15 @@ PushMethodCallFrame( } /* - * Save the old cmdPtr so that when this recursive call returns, we can - * restore it. To do otherwise causes crashes in [info frame] after we - * return from a recursive call. [Bug 3001438] - */ - - fdPtr->oldCmdPtr = pmPtr->procPtr->cmdPtr; - - /* - * Compile the body. This operation may fail. - */ - - memset(&fdPtr->cmd, 0, sizeof(Command)); - fdPtr->cmd.nsPtr = nsPtr; - fdPtr->cmd.clientData = &pmPtr->efi; - pmPtr->procPtr->cmdPtr = &fdPtr->cmd; - - /* + * Compile the body. + * * [Bug 2037727] Always call TclProcCompileProc so that we check not only * that we have bytecode, but also that it remains valid. Note that we set * the namespace of the code here directly; this is a hack, but the * alternative is *so* slow... */ + pmPtr->procPtr->cmdPtr = &pmPtr->cmd; if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) { ByteCode *codePtr = pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; @@ -895,12 +854,12 @@ PushMethodCallFrame( pmPtr->procPtr->bodyPtr, nsPtr, "body of method", TclGetString(fdPtr->nameObj)); if (result != TCL_OK) { - goto failureReturn; + return result; } /* * Make the stack frame and fill it out with information about this call. - * This operation may fail. + * This operation doesn't ever actually fail. */ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, @@ -912,15 +871,6 @@ PushMethodCallFrame( fdPtr->framePtr->procPtr = pmPtr->procPtr; return TCL_OK; - - /* - * Restore the old cmdPtr so that a subsequent use of [info frame] won't - * crash on us. [Bug 3001438] - */ - - failureReturn: - pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; - return result; } /* @@ -1357,6 +1307,8 @@ CloneProcedureMethod( pm2Ptr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod)); pm2Ptr->refCount = 1; + pm2Ptr->cmd.clientData = &pm2Ptr->efi; + pm2Ptr->efi.length = 0; /* Trigger a reinit of this. */ Tcl_IncrRefCount(argsObj); Tcl_IncrRefCount(bodyObj); if (TclCreateProc(interp, NULL, "", argsObj, bodyObj, diff --git a/tests/oo.test b/tests/oo.test index 8bc6363..8e2cb5f 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -3296,56 +3296,121 @@ test oo-22.2 {OO and info frame: Bug 3001438} -setup { } -match glob -cleanup { c destroy } -result {* cmd {info frame 0} method test class ::c level 0} -test oo-22.3 {OO and coroutines and info frame} -constraints knownBug -setup { - oo::class create A { - self { - variable result stop - method WithWorkers {nworkers args script} { - set workers {} - try { - for {set n 1} {$n <= $nworkers} {incr n} { - lappend workers [set worker [[self] new]] - $worker schedule {*}$args - } - return [uplevel 1 $script] - } finally { - foreach worker $workers {$worker destroy} - } - } - method run {nworkers} { - set result {} - set stopvar [my varname stop] - set stop false - my WithWorkers $nworkers [list my Work [my varname result]] { - after idle [namespace code {set stop true}] - vwait $stopvar - } - return $result +# Common code for oo-22.{3,4,5,6} +oo::class create WorkerBase +oo::class create WorkerSupport { + superclass oo::class WorkerBase + variable result stop + method WithWorkers {nworkers args script} { + set workers {} + try { + for {set n 1} {$n <= $nworkers} {incr n} { + lappend workers [set worker [[self] new]] + $worker schedule {*}$args } + return [uplevel 1 $script] + } finally { + foreach worker $workers {$worker destroy} + } + } + method run {nworkers} { + set result {} + set stopvar [my varname stop] + set stop false + my WithWorkers $nworkers [list my Work [my varname result]] { + after idle [namespace code {set stop true}] + vwait $stopvar } - method schedule {args} { - set coro [namespace current]::coro - if {![llength [info commands $coro]]} { - coroutine $coro {*}$args - } + return $result + } +} +oo::class create Worker { + superclass WorkerBase + method schedule {args} { + set coro [namespace current]::coro + if {![llength [info commands $coro]]} { + coroutine $coro {*}$args } + } + method Work args {error unimplemented} + method dump {} { + info frame [expr {[info frame] - 1}] + } +} +test oo-22.3 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly restored pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker method Work {var} { after 0 [info coroutine] yield - lappend $var [dump] + lappend $var [my dump] } } -} -body { - # Triggers a crash with incorrectly restored procPtr->cmdPtr - proc dump {} { - # Called from [A Work] after a coroutine suspend/resume - info frame [expr {[info frame] - 1}] + A run 2 +} -cleanup { + catch {rename dump {}} + catch {A destroy} +} -match glob -result {{* method Work class ::A *} {* method Work class ::A *}} +test oo-22.4 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker + method Work {var} { + after 0 [info coroutine] + yield + lappend $var [my dump] + } + } + # Copies the methods, changing the declarer + # Test it works with the source class still around + oo::copy A B + B run 2 +} -cleanup { + catch {rename dump {}} + catch {A destroy} + catch {B destroy} +} -match glob -result {{* method Work class ::B *} {* method Work class ::B *}} +test oo-22.5 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker + method Work {var} { + after 0 [info coroutine] + yield + lappend $var [my dump] + } + } + # Copies the methods, changing the declarer + # Test it works with the source class deleted + oo::copy A B + catch {A destroy} + B run 2 +} -cleanup { + catch {rename dump {}} + catch {B destroy} +} -match glob -result {{* method Work class ::B *} {* method Work class ::B *}} +test oo-22.6 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker + method Work {var} { + after 0 [info coroutine] + yield + lappend $var [my dump] + } } + # Copies the methods, changing the declarer + # Test it works in the original source class with the copy around + oo::copy A B + B run 2 A run 2 } -cleanup { catch {rename dump {}} catch {A destroy} + catch {B destroy} } -match glob -result {{* method Work class ::A *} {* method Work class ::A *}} +WorkerBase destroy # Prove that the issue in [Bug 1865054] isn't an issue any more test oo-23.1 {Self-like derivation; complex case!} -setup { -- cgit v0.12 From a8a9dd7928c5767880b492d26f061ffc29992773 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 17 May 2024 13:29:12 +0000 Subject: Remove the band-aid --- generic/tclCmdIL.c | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 279bc7b..aef0399 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1388,12 +1388,7 @@ TclInfoFrame( * Procedure CallFrame. */ - if (procPtr != NULL -#ifndef AVOID_EMERGENCY_HACKS - /* Emergency band-aid fix for [87271f7cd6] */ - && procPtr->cmdPtr != NULL -#endif - ) { + if (procPtr != NULL) { Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr; if (namePtr) { -- cgit v0.12 From 40d50662d90bf51ae1dfceebbe10bb3330fcdda3 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 17 May 2024 15:59:45 +0000 Subject: Utility branch I can sensibly compare with core-9-0-b2-rc --- generic/tcl.h | 182 +++--- generic/tclAlloc.c | 31 +- generic/tclBasic.c | 1402 +++++++++++++++++++++---------------------- generic/tclBinary.c | 1 + generic/tclCkalloc.c | 39 +- generic/tclClock.c | 5 + generic/tclCmdAH.c | 15 +- generic/tclCmdIL.c | 1 + generic/tclCompCmds.c | 4 + generic/tclCompCmdsSZ.c | 1 + generic/tclCompExpr.c | 2 +- generic/tclCompile.h | 352 ++++++----- generic/tclDisassemble.c | 19 +- generic/tclEncoding.c | 24 +- generic/tclEnv.c | 9 +- generic/tclEvent.c | 2 + generic/tclExecute.c | 382 ++++++------ generic/tclHash.c | 4 +- generic/tclIO.c | 27 +- generic/tclIO.h | 4 +- generic/tclIOCmd.c | 1 + generic/tclIORChan.c | 57 +- generic/tclIORTrans.c | 28 +- generic/tclIOSock.c | 8 +- generic/tclIOUtil.c | 63 +- generic/tclInt.h | 843 +++++++++++++------------- generic/tclInterp.c | 5 +- generic/tclListObj.c | 5 +- generic/tclLoad.c | 31 +- generic/tclNamesp.c | 5 +- generic/tclOOCall.c | 1 + generic/tclOOMethod.c | 2 +- generic/tclObj.c | 2 + generic/tclPanic.c | 1 + generic/tclParse.c | 2 +- generic/tclPathObj.c | 2 + generic/tclProc.c | 61 +- generic/tclProcess.c | 4 +- generic/tclRegexp.c | 25 +- generic/tclStrToD.c | 3 + generic/tclStringObj.c | 2 + generic/tclStringRep.h | 1 + generic/tclStubLibTbl.c | 10 +- generic/tclThread.c | 1 + generic/tclTomMathStubLib.c | 1 + generic/tclTrace.c | 1 + generic/tclUtf.c | 2 + generic/tclUtil.c | 8 +- generic/tclZipfs.c | 27 +- macosx/tclMacOSXNotify.c | 1 + unix/tclKqueueNotfy.c | 3 +- unix/tclLoadNext.c | 1 + unix/tclLoadOSF.c | 1 + unix/tclUnixInit.c | 1 + win/tclWinChan.c | 5 +- win/tclWinConsole.c | 5 +- win/tclWinFCmd.c | 1 + win/tclWinInt.h | 4 +- win/tclWinPipe.c | 1 + win/tclWinPort.h | 3 + win/tclWinSerial.c | 2 + win/tclWinThrd.c | 24 +- win/tclWinTime.c | 1 + 63 files changed, 1893 insertions(+), 1868 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 947e4a7..e40e8a9 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -48,15 +48,15 @@ extern "C" { */ #if !defined(TCL_MAJOR_VERSION) -# define TCL_MAJOR_VERSION 9 +# define TCL_MAJOR_VERSION 9 #endif #if TCL_MAJOR_VERSION == 9 -# define TCL_MINOR_VERSION 0 -# define TCL_RELEASE_LEVEL TCL_BETA_RELEASE -# define TCL_RELEASE_SERIAL 2 +# define TCL_MINOR_VERSION 0 +# define TCL_RELEASE_LEVEL TCL_BETA_RELEASE +# define TCL_RELEASE_SERIAL 2 -# define TCL_VERSION "9.0" -# define TCL_PATCH_LEVEL "9.0b2" +# define TCL_VERSION "9.0" +# define TCL_PATCH_LEVEL "9.0b2" #endif /* TCL_MAJOR_VERSION */ #if defined(RC_INVOKED) @@ -90,8 +90,7 @@ extern "C" { * Special macro to define mutexes. */ -#define TCL_DECLARE_MUTEX(name) \ - static Tcl_Mutex name; +#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name; /* * Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and @@ -465,9 +464,9 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData); typedef struct Tcl_RegExpIndices { #if TCL_MAJOR_VERSION > 8 - Tcl_Size start; /* Character offset of first character in + Tcl_Size start; /* Character offset of first character in * match. */ - Tcl_Size end; /* Character offset of first character after + Tcl_Size end; /* Character offset of first character after * the match. */ #else long start; @@ -476,11 +475,11 @@ typedef struct Tcl_RegExpIndices { } Tcl_RegExpIndices; typedef struct Tcl_RegExpInfo { - Tcl_Size nsubs; /* Number of subexpressions in the compiled + Tcl_Size nsubs; /* Number of subexpressions in the compiled * expression. */ Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ #if TCL_MAJOR_VERSION > 8 - Tcl_Size extendStart; /* The offset at which a subsequent match + Tcl_Size extendStart; /* The offset at which a subsequent match * might begin. */ #else long extendStart; @@ -616,25 +615,28 @@ typedef void (Tcl_ServiceModeHookProc) (int mode); typedef void *(Tcl_InitNotifierProc) (void); typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); - + /* Abstract List functions */ -typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr); -typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size index, struct Tcl_Obj** elemObj); -typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size fromIdx, Tcl_Size toIdx, struct Tcl_Obj **newObjPtr); -typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, - struct Tcl_Obj *listPtr, struct Tcl_Obj **newObjPtr); -typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, - struct Tcl_Obj *listPtr, Tcl_Size *objcptr, struct Tcl_Obj ***objvptr); -typedef struct Tcl_Obj *(Tcl_ObjTypeSetElement) (Tcl_Interp *interp, - struct Tcl_Obj *listPtr, Tcl_Size indexCount, - struct Tcl_Obj *const indexArray[], struct Tcl_Obj *valueObj); -typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, - struct Tcl_Obj *listObj, Tcl_Size first, Tcl_Size numToDelete, - Tcl_Size numToInsert, struct Tcl_Obj *const insertObjs[]); -typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, - struct Tcl_Obj *valueObj, struct Tcl_Obj *listObj, int *boolResult); +typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr); +typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size index, struct Tcl_Obj** elemObj); +typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size fromIdx, Tcl_Size toIdx, + struct Tcl_Obj **newObjPtr); +typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + struct Tcl_Obj **newObjPtr); +typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size *objcptr, struct Tcl_Obj ***objvptr); +typedef struct Tcl_Obj* (Tcl_ObjTypeSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size indexCount, + struct Tcl_Obj *const indexArray[], + struct Tcl_Obj *valueObj); +typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj, + Tcl_Size first, Tcl_Size numToDelete, + Tcl_Size numToInsert, + struct Tcl_Obj *const insertObjs[]); +typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj, + struct Tcl_Obj *listObj, int *boolResult); #ifndef TCL_NO_DEPRECATED # define Tcl_PackageInitProc Tcl_LibraryInitProc @@ -668,36 +670,33 @@ typedef struct Tcl_ObjType { size_t version; /* List emulation functions - ObjType Version 1 */ - Tcl_ObjTypeLengthProc *lengthProc; - /* Return the [llength] of the AbstractList */ - Tcl_ObjTypeIndexProc *indexProc; - /* Return a value (Tcl_Obj) at a given index */ - Tcl_ObjTypeSliceProc *sliceProc; - /* Return an AbstractList for - * [lrange $al $start $end] */ - Tcl_ObjTypeReverseProc *reverseProc; - /* Return an AbstractList for [lreverse $al] */ - Tcl_ObjTypeGetElements *getElementsProc; - /* Return an objv[] of all elements in the list */ - Tcl_ObjTypeSetElement *setElementProc; - /* Replace the element at the indicies with the - * given valueObj. */ - Tcl_ObjTypeReplaceProc *replaceProc; - /* Replace sublist with another sublist */ - Tcl_ObjTypeInOperatorProc *inOperProc; - /* "in" and "ni" expr list operation. - * Determine if the given string value matches - * an element in the list. */ + Tcl_ObjTypeLengthProc *lengthProc; /* Return the [llength] of the + ** AbstractList */ + Tcl_ObjTypeIndexProc *indexProc; /* Return a value (Tcl_Obj) for + ** [lindex $al $index] */ + Tcl_ObjTypeSliceProc *sliceProc; /* Return an AbstractList for + ** [lrange $al $start $end] */ + Tcl_ObjTypeReverseProc *reverseProc; /* Return an AbstractList for + ** [lreverse $al] */ + Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in + ** the list */ + Tcl_ObjTypeSetElement *setElementProc; /* Replace the element at the indicie + ** with the given valueObj. */ + Tcl_ObjTypeReplaceProc *replaceProc; /* Replace subset with subset */ + Tcl_ObjTypeInOperatorProc *inOperProc; /* "in" and "ni" expr list + ** operation Determine if the given + ** string value matches an element in + ** the list */ #endif } Tcl_ObjType; #if TCL_MAJOR_VERSION > 8 # define TCL_OBJTYPE_V0 0, \ - 0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */ + 0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */ # define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \ - a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */ + a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */ # define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType), \ - a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */ + a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */ #else # define TCL_OBJTYPE_V0 /* just empty */ #endif @@ -750,9 +749,9 @@ typedef struct Tcl_Obj { * corresponds to the type of the object's * internal rep. NULL indicates the object has * no internal rep (has no type). */ - Tcl_ObjInternalRep internalRep; - /* The internal representation: */ + Tcl_ObjInternalRep internalRep; /* The internal representation: */ } Tcl_Obj; + /* *---------------------------------------------------------------------------- @@ -768,7 +767,7 @@ typedef struct Tcl_Namespace { * is an synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - void *clientData; /* Arbitrary value associated with this + void *clientData; /* Arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Function invoked when deleting the @@ -842,11 +841,11 @@ typedef struct { Tcl_ObjCmdProc *objProc; /* Command's object-based function. */ void *objClientData; /* ClientData for object proc. */ Tcl_CmdProc *proc; /* Command's string-based function. */ - void *clientData; /* ClientData for string proc. */ + void *clientData; /* ClientData for string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Function to call when command is * deleted. */ - void *deleteData; /* Value to pass to deleteProc (usually the + void *deleteData; /* Value to pass to deleteProc (usually the * same as clientData). */ Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this * command. Note that Tcl_SetCmdInfo will not @@ -965,7 +964,7 @@ typedef struct Tcl_DString { * TCL_CANCEL_UNWIND: Magical Tcl_CancelEval mode that causes the * stack for the script in progress to be * completely unwound. - * TCL_EVAL_NOERR: Do no exception reporting at all, just return + * TCL_EVAL_NOERR: Do no exception reporting at all, just return * as the caller will report. */ @@ -1078,7 +1077,7 @@ struct Tcl_HashEntry { * or NULL for end of chain. */ Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ size_t hash; /* Hash value. */ - void *clientData; /* Application stores something here with + void *clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ char *oneWordValue; /* One-word value for key. */ @@ -1174,11 +1173,11 @@ struct Tcl_HashTable { Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - Tcl_Size numBuckets; /* Total number of buckets allocated at + Tcl_Size numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ - Tcl_Size numEntries; /* Total number of entries present in + Tcl_Size numEntries; /* Total number of entries present in * table. */ - Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be + Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ #if TCL_MAJOR_VERSION > 8 size_t mask; /* Mask value used in hashing function. */ @@ -1187,7 +1186,7 @@ struct Tcl_HashTable { * Designed to use high-order bits of * randomized keys. */ #if TCL_MAJOR_VERSION < 9 - int mask; /* Mask value used in hashing function. */ + int mask; /* Mask value used in hashing function. */ #endif int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, @@ -1777,8 +1776,8 @@ typedef struct Tcl_Token { int type; /* Type of token, such as TCL_TOKEN_WORD; see * below for valid types. */ const char *start; /* First character in token. */ - Tcl_Size size; /* Number of bytes in token. */ - Tcl_Size numComponents; /* If this token is composed of other tokens, + Tcl_Size size; /* Number of bytes in token. */ + Tcl_Size numComponents; /* If this token is composed of other tokens, * this field tells how many of them there are * (including components of components, etc.). * The component tokens immediately follow @@ -1892,13 +1891,13 @@ typedef struct Tcl_Token { typedef struct Tcl_Parse { const char *commentStart; /* Pointer to # that begins the first of one * or more comments preceding the command. */ - Tcl_Size commentSize; /* Number of bytes in comments (up through + Tcl_Size commentSize; /* Number of bytes in comments (up through * newline character that terminates the last * comment). If there were no comments, this * field is 0. */ const char *commandStart; /* First character in first word of * command. */ - Tcl_Size commandSize; /* Number of bytes in command, including first + Tcl_Size commandSize; /* Number of bytes in command, including first * character of first word, up through the * terminating newline, close bracket, or * semicolon. */ @@ -1968,7 +1967,7 @@ typedef struct Tcl_EncodingType { Tcl_FreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ - void *clientData; /* Arbitrary value associated with encoding + void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ Tcl_Size nullSize; /* Number of zero bytes that signify * end-of-string in this encoding. This number @@ -2174,7 +2173,7 @@ typedef struct { * depends on type.*/ const char *helpStr; /* Documentation message describing this * option. */ - void *clientData; /* Word to pass to function callbacks. */ + void *clientData; /* Word to pass to function callbacks. */ } Tcl_ArgvInfo; /* @@ -2294,9 +2293,9 @@ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, */ #if TCL_MAJOR_VERSION > 8 -# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) +# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) #else -# define TCL_STUB_MAGIC ((int) 0xFCA3BACF) +# define TCL_STUB_MAGIC ((int) 0xFCA3BACF) #endif /* @@ -2313,7 +2312,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char * TclInitStubTable(const char *version); void * TclStubCall(void *arg); #if defined(_WIN32) - TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...); + TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...); #else # define Tcl_ConsolePanic ((Tcl_PanicProc *)NULL) #endif @@ -2361,8 +2360,7 @@ void * TclStubCall(void *arg); * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ -#define Tcl_Main(argc, argv, proc) \ - Tcl_MainEx(argc, argv, proc, \ +#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp()))) EXTERN TCL_NORETURN void Tcl_MainEx(Tcl_Size argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); @@ -2381,9 +2379,9 @@ EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp, #ifndef TCL_NO_DEPRECATED # define Tcl_StaticPackage Tcl_StaticLibrary #endif -EXTERN Tcl_ExitProc * Tcl_SetExitProc(Tcl_ExitProc *proc); +EXTERN Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc); #ifdef _WIN32 -EXTERN const char * TclZipfs_AppHook(int *argc, wchar_t ***argv); +EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv); #else EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); #endif @@ -2503,11 +2501,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); # define Tcl_BounceRefCount(objPtr) \ TclBounceRefCount(objPtr, __FILE__, __LINE__) -static inline void -TclBounceRefCount( - Tcl_Obj* objPtr, - const char* fn, - int line) +static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line) { if (objPtr) { if ((objPtr)->refCount == 0) { @@ -2525,11 +2519,11 @@ TclBounceRefCount( */ # undef Tcl_DecrRefCount # define Tcl_DecrRefCount(objPtr) \ - do { \ - Tcl_Obj *_objPtr = (objPtr); \ - if (_objPtr->refCount-- <= 1) { \ - TclFreeObj(_objPtr); \ - } \ + do { \ + Tcl_Obj *_objPtr = (objPtr); \ + if (_objPtr->refCount-- <= 1) { \ + TclFreeObj(_objPtr); \ + } \ } while(0) # undef Tcl_IsShared # define Tcl_IsShared(objPtr) \ @@ -2540,12 +2534,10 @@ TclBounceRefCount( * This will release the obj if there is no referece count, * otherwise let it be. */ -# define Tcl_BounceRefCount(objPtr) \ +# define Tcl_BounceRefCount(objPtr) \ TclBounceRefCount(objPtr); -static inline void -TclBounceRefCount( - Tcl_Obj* objPtr) +static inline void TclBounceRefCount(Tcl_Obj* objPtr) { if (objPtr) { if ((objPtr)->refCount == 0) { @@ -2597,10 +2589,10 @@ TclBounceRefCount( #define Tcl_GetHashValue(h) ((h)->clientData) #define Tcl_SetHashValue(h, value) ((h)->clientData = (void *)(value)) #define Tcl_GetHashKey(tablePtr, h) \ - ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ - (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ - ? (h)->key.oneWordValue \ - : (h)->key.string)) + ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ + (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ + ? (h)->key.oneWordValue \ + : (h)->key.string)) /* * Macros to use for clients to use to invoke find and create functions for diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index b52d1b3..3c4fac3 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -47,18 +47,17 @@ typedef size_t caddr_t; */ union overhead { - union overhead *next; /* when free */ - unsigned char padding[TCL_ALLOCALIGN]; - /* align struct to TCL_ALLOCALIGN bytes */ + union overhead *next; /* when free */ + unsigned char padding[TCL_ALLOCALIGN]; /* align struct to TCL_ALLOCALIGN bytes */ struct { - unsigned char magic0; /* magic number */ - unsigned char index; /* bucket # */ - unsigned char unused; /* unused */ - unsigned char magic1; /* other magic number */ + unsigned char magic0; /* magic number */ + unsigned char index; /* bucket # */ + unsigned char unused; /* unused */ + unsigned char magic1; /* other magic number */ #ifndef NDEBUG - unsigned short rmagic; /* range magic number */ + unsigned short rmagic; /* range magic number */ size_t size; /* actual block size */ - unsigned short unused2; /* padding to 8-byte align */ + unsigned short unused2; /* padding to 8-byte align */ #endif } ovu; #define overMagic0 ovu.magic0 @@ -68,6 +67,7 @@ union overhead { #define realBlockSize ovu.size }; + #define MAGIC 0xEF /* magic # on accounting info */ #define RMAGIC 0x5555 /* magic # on range info */ @@ -92,8 +92,7 @@ union overhead { * precedes the data area returned to the user. */ -#define MINBLOCK \ - ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) +#define MINBLOCK ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) #define NBUCKETS (13 - (MINBLOCK >> 4)) #define MAXMALLOC ((size_t)1 << (NBUCKETS+2)) static union overhead *nextf[NBUCKETS]; @@ -252,7 +251,7 @@ TclFinalizeAllocSubsystem(void) void * TclpAlloc( - size_t numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { union overhead *overPtr; size_t bucket; @@ -386,10 +385,10 @@ TclpAlloc( static void MoreCore( - size_t bucket) /* What bucket to allocate to. */ + size_t bucket) /* What bucket to allocate to. */ { union overhead *overPtr; - size_t size; /* size of desired block */ + size_t size; /* size of desired block */ size_t amount; /* amount to allocate */ size_t numBlocks; /* how many blocks we get */ struct block *blockPtr; @@ -512,7 +511,7 @@ TclpFree( void * TclpRealloc( void *oldPtr, /* Pointer to alloc'ed block. */ - size_t numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { int i; union overhead *overPtr; @@ -744,7 +743,7 @@ TclpFree( void * TclpRealloc( void *oldPtr, /* Pointer to alloced block. */ - size_t numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { return realloc(oldPtr, numBytes); } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 3940d4b..3faa201 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -63,6 +63,7 @@ /* actually there is no fallback to builtin fpclassify */ #endif /* !TCL_FPCLASSIFY_MODE */ + /* * Bug 7371b6270b: to check C call stack depth, prefer an approach which is * compatible with AddressSanitizer (ASan) use-after-return detection. @@ -84,17 +85,17 @@ void * TclGetCStackPtr(void) { #if defined( __GNUC__ ) || __has_builtin(__builtin_frame_address) - return __builtin_frame_address(0); + return __builtin_frame_address(0); #elif defined(_MSC_VER) && defined(HAVE_INTRIN_H) - return _AddressOfReturnAddress(); + return _AddressOfReturnAddress(); #else - ptrdiff_t unused = 0; - /* - * LLVM recommends using volatile: - * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31 - */ - ptrdiff_t *volatile stackLevel = &unused; - return (void *)stackLevel; + ptrdiff_t unused = 0; + /* + * LLVM recommends using volatile: + * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31 + */ + ptrdiff_t *volatile stackLevel = &unused; + return (void *)stackLevel; #endif } @@ -167,7 +168,7 @@ TCL_DECLARE_MUTEX(commandTypeLock); * Static functions in this file: */ -static Tcl_ObjCmdProc BadEnsembleSubcommand; +static Tcl_ObjCmdProc BadEnsembleSubcommand; static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr, const char *oldName, const char *newName, int flags); @@ -192,12 +193,12 @@ static Tcl_ObjCmdProc ExprDoubleFunc; static Tcl_ObjCmdProc ExprFloorFunc; static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; -static Tcl_ObjCmdProc ExprIsFiniteFunc; -static Tcl_ObjCmdProc ExprIsInfinityFunc; -static Tcl_ObjCmdProc ExprIsNaNFunc; -static Tcl_ObjCmdProc ExprIsNormalFunc; -static Tcl_ObjCmdProc ExprIsSubnormalFunc; -static Tcl_ObjCmdProc ExprIsUnorderedFunc; +static Tcl_ObjCmdProc ExprIsFiniteFunc; +static Tcl_ObjCmdProc ExprIsInfinityFunc; +static Tcl_ObjCmdProc ExprIsNaNFunc; +static Tcl_ObjCmdProc ExprIsNormalFunc; +static Tcl_ObjCmdProc ExprIsSubnormalFunc; +static Tcl_ObjCmdProc ExprIsUnorderedFunc; static Tcl_ObjCmdProc ExprMaxFunc; static Tcl_ObjCmdProc ExprMinFunc; static Tcl_ObjCmdProc ExprRandFunc; @@ -206,7 +207,7 @@ static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; -static Tcl_ObjCmdProc FloatClassifyObjCmd; +static Tcl_ObjCmdProc FloatClassifyObjCmd; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; @@ -252,11 +253,11 @@ MODULE_SCOPE const TclStubs tclStubs; * after particular kinds of [yield]. */ -#define CORO_ACTIVATE_YIELD NULL -#define CORO_ACTIVATE_YIELDM INT2PTR(1) +#define CORO_ACTIVATE_YIELD NULL +#define CORO_ACTIVATE_YIELDM INT2PTR(1) -#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) -#define COROUTINE_ARGUMENTS_ARBITRARY (-2) +#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) +#define COROUTINE_ARGUMENTS_ARBITRARY (-2) /* * The following structure define the commands in the Tcl core. @@ -270,9 +271,9 @@ typedef struct { int flags; /* Various flag bits, as defined below. */ } CmdInfo; -#define CMD_IS_SAFE 1 /* Whether this command is part of the set of - * commands present by default in a safe - * interpreter. */ +#define CMD_IS_SAFE 1 /* Whether this command is part of the set of + * commands present by default in a safe + * interpreter. */ /* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle * expansion for itself rather than needing the generic layer to take care of * it for it. Defined in tclInt.h. */ @@ -286,13 +287,13 @@ typedef struct { */ typedef struct { - const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for - * the end of the list of commands to hide. */ - const char *commandName; /* The name of the command within the - * ensemble. If this is NULL, we want to also - * make the overall command be hidden, an ugly - * hack because it is expected by security - * policies in the wild. */ + const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for + * the end of the list of commands to hide. */ + const char *commandName; /* The name of the command within the + * ensemble. If this is NULL, we want to also + * make the overall command be hidden, an ugly + * hack because it is expected by security + * policies in the wild. */ } UnsafeEnsembleInfo; /* @@ -321,8 +322,8 @@ static const CmdInfo builtInCmds[] = { {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"const", Tcl_ConstObjCmd, TclCompileConstCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, - {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, - {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, + {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, + {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE}, {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE}, @@ -330,7 +331,7 @@ static const CmdInfo builtInCmds[] = { {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, - {"fpclassify", FloatClassifyObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"fpclassify", FloatClassifyObjCmd, NULL, NULL, CMD_IS_SAFE}, {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, @@ -345,12 +346,12 @@ static const CmdInfo builtInCmds[] = { {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, {"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, - {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, - {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, {"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE}, @@ -478,52 +479,48 @@ static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = { * Math functions. All are safe. */ -typedef double (BuiltinUnaryFunc)(double x); -typedef double (BuiltinBinaryFunc)(double x, double y); -#define BINARY_TYPECAST(fn) \ - (BuiltinUnaryFunc *)(void *)(BuiltinBinaryFunc *) fn typedef struct { const char *name; /* Name of the function. The full name is * "::tcl::mathfunc::". */ Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */ - BuiltinUnaryFunc *fn; /* Real function pointer */ + double (*fn)(double x); /* Real function pointer */ } BuiltinFuncDef; static const BuiltinFuncDef BuiltinFuncTable[] = { { "abs", ExprAbsFunc, NULL }, { "acos", ExprUnaryFunc, acos }, { "asin", ExprUnaryFunc, asin }, { "atan", ExprUnaryFunc, atan }, - { "atan2", ExprBinaryFunc, BINARY_TYPECAST(atan2) }, + { "atan2", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) atan2}, { "bool", ExprBoolFunc, NULL }, { "ceil", ExprCeilFunc, NULL }, - { "cos", ExprUnaryFunc, cos }, + { "cos", ExprUnaryFunc, cos }, { "cosh", ExprUnaryFunc, cosh }, { "double", ExprDoubleFunc, NULL }, { "entier", ExprIntFunc, NULL }, - { "exp", ExprUnaryFunc, exp }, + { "exp", ExprUnaryFunc, exp }, { "floor", ExprFloorFunc, NULL }, - { "fmod", ExprBinaryFunc, BINARY_TYPECAST(fmod) }, - { "hypot", ExprBinaryFunc, BINARY_TYPECAST(hypot) }, + { "fmod", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) fmod}, + { "hypot", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) hypot}, { "int", ExprIntFunc, NULL }, - { "isfinite", ExprIsFiniteFunc, NULL }, - { "isinf", ExprIsInfinityFunc, NULL }, - { "isnan", ExprIsNaNFunc, NULL }, - { "isnormal", ExprIsNormalFunc, NULL }, + { "isfinite", ExprIsFiniteFunc, NULL }, + { "isinf", ExprIsInfinityFunc, NULL }, + { "isnan", ExprIsNaNFunc, NULL }, + { "isnormal", ExprIsNormalFunc, NULL }, { "isqrt", ExprIsqrtFunc, NULL }, - { "issubnormal", ExprIsSubnormalFunc, NULL, }, - { "isunordered", ExprIsUnorderedFunc, NULL, }, - { "log", ExprUnaryFunc, log }, + { "issubnormal", ExprIsSubnormalFunc, NULL, }, + { "isunordered", ExprIsUnorderedFunc, NULL, }, + { "log", ExprUnaryFunc, log }, { "log10", ExprUnaryFunc, log10 }, { "max", ExprMaxFunc, NULL }, { "min", ExprMinFunc, NULL }, - { "pow", ExprBinaryFunc, BINARY_TYPECAST(pow) }, + { "pow", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) pow}, { "rand", ExprRandFunc, NULL }, { "round", ExprRoundFunc, NULL }, - { "sin", ExprUnaryFunc, sin }, + { "sin", ExprUnaryFunc, sin }, { "sinh", ExprUnaryFunc, sinh }, { "sqrt", ExprSqrtFunc, NULL }, { "srand", ExprSrandFunc, NULL }, - { "tan", ExprUnaryFunc, tan }, + { "tan", ExprUnaryFunc, tan }, { "tanh", ExprUnaryFunc, tanh }, { "wide", ExprWideFunc, NULL }, { NULL, NULL, NULL } @@ -631,8 +628,8 @@ TclFinalizeEvaluation(void) Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_DeleteHashTable(&commandTypeTable); - commandTypeInit = 0; + Tcl_DeleteHashTable(&commandTypeTable); + commandTypeInit = 0; } Tcl_MutexUnlock(&commandTypeLock); } @@ -671,8 +668,8 @@ buildInfoObjCmd2( char buf[80]; const char *p = strchr((char *)clientData, '.'); if (p) { - const char *q = strchr(p + 1, '.'); - const char *r = strchr(p + 1, '+'); + const char *q = strchr(p+1, '.'); + const char *r = strchr(p+1, '+'); p = (q < r) ? q : r; } if (p) { @@ -695,45 +692,42 @@ buildInfoObjCmd2( if (p) { if ((q = strchr(p, '.'))) { char buf[80]; - memcpy(buf, p + 1, q - p - 1); + memcpy(buf, p+1, q - p - 1); buf[q - p - 1] = '\0'; Tcl_AppendResult(interp, buf, (char *)NULL); } else { - Tcl_AppendResult(interp, p + 1, (char *)NULL); + Tcl_AppendResult(interp, p+1, (char *)NULL); } } return TCL_OK; } else if (len == 8 && !strcmp(arg, "compiler")) { const char *p = strchr((char *)clientData, '.'); while (p) { - if (!strncmp(p + 1, "clang-", 6) - || !strncmp(p + 1, "gcc-", 4) - || !strncmp(p + 1, "icc-", 4) - || !strncmp(p + 1, "msvc-", 5)) { - const char *q = strchr(p + 1, '.'); + if (!strncmp(p+1, "clang-", 6) || !strncmp(p+1, "gcc-", 4) + || !strncmp(p+1, "icc-", 4) || !strncmp(p+1, "msvc-", 5)) { + const char *q = strchr(p+1, '.'); if (q) { char buf[16]; - memcpy(buf, p + 1, q - p - 1); + memcpy(buf, p+1, q - p - 1); buf[q - p - 1] = '\0'; Tcl_AppendResult(interp, buf, (char *)NULL); } else { - Tcl_AppendResult(interp, p + 1, (char *)NULL); + Tcl_AppendResult(interp, p+1, (char *)NULL); } return TCL_OK; } - p = strchr(p + 1, '.'); + p = strchr(p+1, '.'); } Tcl_AppendResult(interp, "0", (char *)NULL); return TCL_OK; } const char *p = strchr((char *)clientData, '.'); while (p) { - if (!strncmp(p + 1, arg, len) - && ((p[len + 1] == '.') || (p[len + 1] == '\0'))) { + if (!strncmp(p+1, arg, len) && ((p[len+1] == '.') || (p[len+1] == '\0'))) { Tcl_AppendResult(interp, "1", (char *)NULL); return TCL_OK; } - p = strchr(p + 1, '.'); + p = strchr(p+1, '.'); } Tcl_AppendResult(interp, "0", (char *)NULL); return TCL_OK; @@ -825,16 +819,16 @@ Tcl_CreateInterp(void) #undef TclObjInterpProc if (commandTypeInit == 0) { - TclRegisterCommandTypeName(TclObjInterpProc, "proc"); - TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); - TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclChildObjCmd, "interp"); - TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); - TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); - TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); - TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); - TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); + TclRegisterCommandTypeName(TclObjInterpProc, "proc"); + TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); + TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclChildObjCmd, "interp"); + TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); + TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); + TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); + TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); + TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); } /* @@ -947,7 +941,7 @@ Tcl_CreateInterp(void) iPtr->flags |= INTERP_DEBUG_FRAME; #else if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) { - iPtr->flags |= INTERP_DEBUG_FRAME; + iPtr->flags |= INTERP_DEBUG_FRAME; } #endif @@ -973,7 +967,7 @@ Tcl_CreateInterp(void) */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ - framePtr = (CallFrame *) Tcl_Alloc(sizeof(CallFrame)); + framePtr = (CallFrame *)Tcl_Alloc(sizeof(CallFrame)); (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0); framePtr->objc = 0; @@ -1003,7 +997,7 @@ Tcl_CreateInterp(void) TclNewObj(iPtr->asyncCancelMsg); - cancelInfo = (CancelInfo *) Tcl_Alloc(sizeof(CancelInfo)); + cancelInfo = (CancelInfo *)Tcl_Alloc(sizeof(CancelInfo)); cancelInfo->interp = interp; iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo); @@ -1067,7 +1061,7 @@ Tcl_CreateInterp(void) */ #if TCL_THREADS && defined(USE_THREAD_ALLOC) - iPtr->allocCache = (AllocCache *) TclpGetAllocCache(); + iPtr->allocCache = (AllocCache *)TclpGetAllocCache(); #else iPtr->allocCache = NULL; #endif @@ -1091,7 +1085,7 @@ Tcl_CreateInterp(void) hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, cmdInfoPtr->name, &isNew); if (isNew) { - cmdPtr = (Command *) Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; cmdPtr->refCount = 1; @@ -1104,9 +1098,9 @@ Tcl_CreateInterp(void) cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; - if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { - cmdPtr->flags |= CMD_COMPILES_EXPANDED; - } + if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { + cmdPtr->flags |= CMD_COMPILES_EXPANDED; + } cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = cmdInfoPtr->nreProc; @@ -1166,15 +1160,15 @@ Tcl_CreateInterp(void) /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, - "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, - TclNRAssembleObjCmd, NULL, NULL); + "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, + TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRInjectObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype", - CoroTypeObjCmd, NULL, NULL); + CoroTypeObjCmd, NULL, NULL); /* Export unsupported commands */ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); @@ -1182,6 +1176,7 @@ Tcl_CreateInterp(void) Tcl_Export(interp, nsPtr, "*", 1); } + #ifdef USE_DTRACE /* * Register the tcl::dtrace command. @@ -1202,7 +1197,7 @@ Tcl_CreateInterp(void) memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN); for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL; builtinFuncPtr++) { - strcpy(mathFuncName + MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); + strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, builtinFuncPtr->objCmdProc, (void *)builtinFuncPtr->fn, NULL); Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0); @@ -1220,8 +1215,7 @@ Tcl_CreateInterp(void) #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ - TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) - Tcl_Alloc(sizeof(TclOpCmdClientData)); + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)Tcl_Alloc(sizeof(TclOpCmdClientData)); occdPtr->op = opcmdInfoPtr->name; occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; @@ -1327,7 +1321,7 @@ static void DeleteOpCmdClientData( void *clientData) { - TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) clientData; + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; Tcl_Free(occdPtr); } @@ -1337,10 +1331,10 @@ DeleteOpCmdClientData( * * TclRegisterCommandTypeName, TclGetCommandTypeName -- * - * Command type registration and lookup mechanism. Everything is keyed by - * the Tcl_ObjCmdProc for the command, and that is used as the *key* into - * the hash table that maps to constant strings that are names. (It is - * recommended that those names be ASCII.) + * Command type registration and lookup mechanism. Everything is keyed by + * the Tcl_ObjCmdProc for the command, and that is used as the *key* into + * the hash table that maps to constant strings that are names. (It is + * recommended that those names be ASCII.) * * --------------------------------------------------------------------- */ @@ -1354,21 +1348,21 @@ TclRegisterCommandTypeName( Tcl_MutexLock(&commandTypeLock); if (commandTypeInit == 0) { - Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); - commandTypeInit = 1; + Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); + commandTypeInit = 1; } if (nameStr != NULL) { - int isNew; + int isNew; - hPtr = Tcl_CreateHashEntry(&commandTypeTable, - implementationProc, &isNew); - Tcl_SetHashValue(hPtr, (void *) nameStr); + hPtr = Tcl_CreateHashEntry(&commandTypeTable, + implementationProc, &isNew); + Tcl_SetHashValue(hPtr, (void *) nameStr); } else { - hPtr = Tcl_FindHashEntry(&commandTypeTable, - implementationProc); - if (hPtr != NULL) { - Tcl_DeleteHashEntry(hPtr); - } + hPtr = Tcl_FindHashEntry(&commandTypeTable, + implementationProc); + if (hPtr != NULL) { + Tcl_DeleteHashEntry(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); } @@ -1382,15 +1376,15 @@ TclGetCommandTypeName( const char *name = "native"; if (procPtr == NULL) { - procPtr = cmdPtr->nreProc; + procPtr = cmdPtr->nreProc; } Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); - if (hPtr && Tcl_GetHashValue(hPtr)) { - name = (const char *) Tcl_GetHashValue(hPtr); - } + if (hPtr && Tcl_GetHashValue(hPtr)) { + name = (const char *) Tcl_GetHashValue(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); @@ -1430,43 +1424,41 @@ TclHideUnsafeCommands( } for (unsafePtr = unsafeEnsembleCommands; - unsafePtr->ensembleNsName; unsafePtr++) { - if (unsafePtr->commandName) { - /* - * Hide an ensemble subcommand. - */ - - Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - -#define INTERIM_HACK_NAME "___tmp" - - if (TclRenameCommand(interp, TclGetString(cmdName), - INTERIM_HACK_NAME) != TCL_OK - || Tcl_HideCommand(interp, INTERIM_HACK_NAME, - TclGetString(hideName)) != TCL_OK) { - Tcl_Panic("problem making '%s %s' safe: %s", - unsafePtr->ensembleNsName, unsafePtr->commandName, - Tcl_GetStringResult(interp)); - } - Tcl_CreateObjCommand(interp, TclGetString(cmdName), - BadEnsembleSubcommand, (void *)unsafePtr, NULL); - TclDecrRefCount(cmdName); - TclDecrRefCount(hideName); - } else { - /* - * Hide an ensemble main command (for compatibility). - */ - - if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, - unsafePtr->ensembleNsName) != TCL_OK) { - Tcl_Panic("problem making '%s' safe: %s", - unsafePtr->ensembleNsName, - Tcl_GetStringResult(interp)); - } - } + unsafePtr->ensembleNsName; unsafePtr++) { + if (unsafePtr->commandName) { + /* + * Hide an ensemble subcommand. + */ + + Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + + if (TclRenameCommand(interp, TclGetString(cmdName), + "___tmp") != TCL_OK + || Tcl_HideCommand(interp, "___tmp", + TclGetString(hideName)) != TCL_OK) { + Tcl_Panic("problem making '%s %s' safe: %s", + unsafePtr->ensembleNsName, unsafePtr->commandName, + Tcl_GetStringResult(interp)); + } + Tcl_CreateObjCommand(interp, TclGetString(cmdName), + BadEnsembleSubcommand, (void *)unsafePtr, NULL); + TclDecrRefCount(cmdName); + TclDecrRefCount(hideName); + } else { + /* + * Hide an ensemble main command (for compatibility). + */ + + if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, + unsafePtr->ensembleNsName) != TCL_OK) { + Tcl_Panic("problem making '%s' safe: %s", + unsafePtr->ensembleNsName, + Tcl_GetStringResult(interp)); + } + } } return TCL_OK; @@ -1500,8 +1492,8 @@ BadEnsembleSubcommand( const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData; Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "not allowed to invoke subcommand %s of %s", - infoPtr->commandName, infoPtr->ensembleNsName)); + "not allowed to invoke subcommand %s of %s", + infoPtr->commandName, infoPtr->ensembleNsName)); Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL); return TCL_ERROR; } @@ -1532,22 +1524,22 @@ Tcl_CallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; - int *assocDataCounterPtr = (int *) - Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); + int *assocDataCounterPtr = + (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; - AssocData *dPtr = (AssocData *) Tcl_Alloc(sizeof(AssocData)); + AssocData *dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); Tcl_HashEntry *hPtr; snprintf(buffer, sizeof(buffer), "Assoc Data Key #%d", *assocDataCounterPtr); (*assocDataCounterPtr)++; if (iPtr->assocData == NULL) { - iPtr->assocData = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew); @@ -1580,7 +1572,7 @@ Tcl_DontCallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTablePtr; @@ -1594,7 +1586,7 @@ Tcl_DontCallWhenDeleted( } for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - dPtr = (AssocData *) Tcl_GetHashValue(hPtr); + dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) { Tcl_Free(dPtr); Tcl_DeleteHashEntry(hPtr); @@ -1628,7 +1620,7 @@ Tcl_SetAssocData( const char *name, /* Name for association. */ Tcl_InterpDeleteProc *proc, /* Proc to call when interpreter is about to * be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; AssocData *dPtr; @@ -1636,14 +1628,14 @@ Tcl_SetAssocData( int isNew; if (iPtr->assocData == NULL) { - iPtr->assocData = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew); if (isNew == 0) { - dPtr = (AssocData *) Tcl_GetHashValue(hPtr); + dPtr = (AssocData *)Tcl_GetHashValue(hPtr); } else { - dPtr = (AssocData *) Tcl_Alloc(sizeof(AssocData)); + dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); } dPtr->proc = proc; dPtr->clientData = clientData; @@ -1684,7 +1676,7 @@ Tcl_DeleteAssocData( if (hPtr == NULL) { return; } - dPtr = (AssocData *) Tcl_GetHashValue(hPtr); + dPtr = (AssocData *)Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); @@ -1729,7 +1721,7 @@ Tcl_GetAssocData( if (hPtr == NULL) { return NULL; } - dPtr = (AssocData *) Tcl_GetHashValue(hPtr); + dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if (procPtr != NULL) { *procPtr = dPtr->proc; } @@ -1881,7 +1873,7 @@ DeleteInterpProc( Tcl_MutexLock(&cancelLock); hPtr = Tcl_FindHashEntry(&cancelTable, iPtr); if (hPtr != NULL) { - CancelInfo *cancelInfo = (CancelInfo *) Tcl_GetHashValue(hPtr); + CancelInfo *cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); if (cancelInfo != NULL) { if (cancelInfo->result != NULL) { @@ -1939,13 +1931,13 @@ DeleteInterpProc( hPtr = Tcl_FirstHashEntry(hTablePtr, &search); for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_DeleteCommandFromToken(interp, - (Tcl_Command) Tcl_GetHashValue(hPtr)); + Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(hTablePtr); Tcl_Free(hTablePtr); } + if (iPtr->assocData != NULL) { AssocData *dPtr; @@ -1957,7 +1949,7 @@ DeleteInterpProc( for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search); hPtr != NULL; hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) { - dPtr = (AssocData *) Tcl_GetHashValue(hPtr); + dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } @@ -2045,7 +2037,7 @@ DeleteInterpProc( for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - CmdFrame *cfPtr = (CmdFrame *) Tcl_GetHashValue(hPtr); + CmdFrame *cfPtr = (CmdFrame *)Tcl_GetHashValue(hPtr); Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); procPtr->iPtr = NULL; @@ -2069,7 +2061,7 @@ DeleteInterpProc( for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ExtCmdLoc *eclPtr = (ExtCmdLoc *) Tcl_GetHashValue(hPtr); + ExtCmdLoc *eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hPtr); if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); @@ -2198,7 +2190,7 @@ Tcl_HideCommand( Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" " token (rename)", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); return TCL_ERROR; } @@ -2221,9 +2213,9 @@ Tcl_HideCommand( if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only hide global namespace commands (use rename then hide)", - -1)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); + "can only hide global namespace commands (use rename then hide)", + -1)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } @@ -2233,7 +2225,7 @@ Tcl_HideCommand( hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; if (hiddenCmdTablePtr == NULL) { - hiddenCmdTablePtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + hiddenCmdTablePtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS); iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr; } @@ -2247,9 +2239,9 @@ Tcl_HideCommand( hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "hidden command named \"%s\" already exists", - hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); + "hidden command named \"%s\" already exists", + hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); return TCL_ERROR; } @@ -2351,9 +2343,9 @@ Tcl_ExposeCommand( if (strstr(cmdName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot expose to a namespace (use expose to toplevel, then rename)", - -1)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); + "cannot expose to a namespace (use expose to toplevel, then rename)", + -1)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } @@ -2368,12 +2360,12 @@ Tcl_ExposeCommand( } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown hidden command \"%s\"", hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", - hiddenCmdToken, (char *)NULL); + "unknown hidden command \"%s\"", hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", + hiddenCmdToken, (char *)NULL); return TCL_ERROR; } - cmdPtr = (Command *) Tcl_GetHashValue(hPtr); + cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Check that we have a true global namespace command (enforced by @@ -2407,8 +2399,8 @@ Tcl_ExposeCommand( hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "exposed command \"%s\" already exists", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); + "exposed command \"%s\" already exists", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); return TCL_ERROR; } @@ -2505,7 +2497,7 @@ Tcl_CreateCommand( * specified namespace; otherwise it is put in * the global namespace. */ Tcl_CmdProc *proc, /* Function to associate with cmdName. */ - void *clientData, /* Arbitrary value passed to string proc. */ + void *clientData, /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ @@ -2536,26 +2528,26 @@ Tcl_CreateCommand( */ while (1) { - /* - * Determine where the command should reside. If its name contains - * namespace qualifiers, we put it in the specified namespace; + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; * otherwise, we always put it in the global namespace. - */ + */ - if (strstr(cmdName, "::") != NULL) { + if (strstr(cmdName, "::") != NULL) { Namespace *dummy1, *dummy2; TclGetNamespaceForQualName(interp, cmdName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if ((nsPtr == NULL) || (tail == NULL)) { - return (Tcl_Command) NULL; + return (Tcl_Command) NULL; } - } else { + } else { nsPtr = iPtr->globalNsPtr; tail = cmdName; - } + } - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); if (isNew || deleted) { /* @@ -2566,10 +2558,10 @@ Tcl_CreateCommand( } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ - cmdPtr = (Command *) Tcl_GetHashValue(hPtr); + cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Be careful to preserve any existing import links so we can restore @@ -2624,7 +2616,7 @@ Tcl_CreateCommand( TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = (Command *) Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; @@ -2651,7 +2643,7 @@ Tcl_CreateCommand( cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; - dataPtr = (ImportedCmdData *) refCmdPtr->objClientData; + dataPtr = (ImportedCmdData *)refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; } @@ -2700,6 +2692,7 @@ typedef struct { Tcl_ObjCmdProc2 *nreProc; } CmdWrapperInfo; + static int cmdWrapperProc( void *clientData, @@ -2707,7 +2700,7 @@ cmdWrapperProc( int objc, Tcl_Obj * const *objv) { - CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; if (objc < 0) { objc = -1; } @@ -2718,7 +2711,7 @@ static void cmdWrapperDeleteProc( void *clientData) { - CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; clientData = info->deleteData; Tcl_CmdDeleteProc *deleteProc = info->deleteProc; @@ -2738,13 +2731,14 @@ Tcl_CreateObjCommand2( * the global namespace. */ Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ - Tcl_CmdDeleteProc *deleteProc) + Tcl_CmdDeleteProc *deleteProc /* If not NULL, gives a function to call when * this command is deleted. */ +) { - CmdWrapperInfo *info = (CmdWrapperInfo *) Tcl_Alloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = proc; info->clientData = clientData; info->deleteProc = deleteProc; @@ -2765,11 +2759,12 @@ Tcl_CreateObjCommand( * the global namespace. */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ - Tcl_CmdDeleteProc *deleteProc) + Tcl_CmdDeleteProc *deleteProc /* If not NULL, gives a function to call when * this command is deleted. */ +) { Interp *iPtr = (Interp *) interp; Namespace *nsPtr; @@ -2810,11 +2805,11 @@ Tcl_Command TclCreateObjCommandInNs( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace - * components. */ - Tcl_Namespace *namesp, /* The namespace to create the command in */ + * components. */ + Tcl_Namespace *namesp, /* The namespace to create the command in */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when @@ -2846,10 +2841,10 @@ TclCreateObjCommandInNs( } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ - cmdPtr = (Command *) Tcl_GetHashValue(hPtr); + cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Command already exists; delete it. Be careful to preserve any @@ -2864,14 +2859,14 @@ TclCreateObjCommandInNs( } /* - * Make sure namespace doesn't get deallocated. - */ + * Make sure namespace doesn't get deallocated. + */ cmdPtr->nsPtr->refCount++; Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); nsPtr = (Namespace *) TclEnsureNamespace(interp, - (Tcl_Namespace *) cmdPtr->nsPtr); + (Tcl_Namespace *) cmdPtr->nsPtr); TclNsDecrRefCount(cmdPtr->nsPtr); if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) { @@ -2913,7 +2908,7 @@ TclCreateObjCommandInNs( TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = (Command *) Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; @@ -2941,7 +2936,7 @@ TclCreateObjCommandInNs( while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; - dataPtr = (ImportedCmdData*) refCmdPtr->objClientData; + dataPtr = (ImportedCmdData*)refCmdPtr->objClientData; cmdPtr->refCount++; TclCleanupCommandMacro(dataPtr->realCmdPtr); dataPtr->realCmdPtr = cmdPtr; @@ -2983,12 +2978,12 @@ TclCreateObjCommandInNs( int InvokeStringCommand( - void *clientData, /* Points to command's Command structure. */ + void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Command *cmdPtr = (Command *) clientData; + Command *cmdPtr = (Command *)clientData; int i, result; const char **argv = (const char **) TclStackAlloc(interp, (objc + 1) * sizeof(char *)); @@ -3057,10 +3052,10 @@ TclRenameCommand( cmdPtr = (Command *) cmd; if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't %s \"%s\": command doesn't exist", - ((newName == NULL) || (*newName == '\0')) ? "delete" : "rename", + "can't %s \"%s\": command doesn't exist", + ((newName == NULL)||(*newName == '\0'))? "delete":"rename", oldName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); return TCL_ERROR; } @@ -3090,16 +3085,16 @@ TclRenameCommand( if ((newNsPtr == NULL) || (newTail == NULL)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": bad command name", newName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); + "can't rename to \"%s\": bad command name", newName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); result = TCL_ERROR; goto done; } if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": command already exists", newName)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", - "TARGET_EXISTS", (char *)NULL); + "can't rename to \"%s\": command already exists", newName)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", + "TARGET_EXISTS", (char *)NULL); result = TCL_ERROR; goto done; } @@ -3271,7 +3266,7 @@ Tcl_SetCommandInfo( static int invokeObj2Command( - void *clientData, /* Points to command's Command structure. */ + void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3298,7 +3293,7 @@ cmdWrapper2Proc( Tcl_Size objc, Tcl_Obj *const objv[]) { - Command *cmdPtr = (Command *) clientData; + Command *cmdPtr = (Command *)clientData; if (objc > INT_MAX) { return TclCommandWordLimitError(interp, objc); } @@ -3335,7 +3330,7 @@ Tcl_SetCommandInfoFromToken( cmdPtr->objClientData = infoPtr->objClientData; } if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { - CmdWrapperInfo *info = (CmdWrapperInfo *) cmdPtr->deleteData; + CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; if (infoPtr->objProc2 == NULL) { info->proc = invokeObj2Command; info->clientData = cmdPtr; @@ -3351,8 +3346,7 @@ Tcl_SetCommandInfoFromToken( info->deleteData = infoPtr->deleteData; } else { if ((infoPtr->objProc2 != NULL) && (infoPtr->objProc2 != cmdWrapper2Proc)) { - CmdWrapperInfo *info = (CmdWrapperInfo *) - Tcl_Alloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = infoPtr->objProc2; info->clientData = infoPtr->objClientData2; info->nreProc = NULL; @@ -3443,7 +3437,7 @@ Tcl_GetCommandInfoFromToken( infoPtr->proc = cmdPtr->proc; infoPtr->clientData = cmdPtr->clientData; if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { - CmdWrapperInfo *info = (CmdWrapperInfo *) cmdPtr->deleteData; + CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; infoPtr->deleteProc = info->deleteProc; infoPtr->deleteData = info->deleteData; infoPtr->objProc2 = info->proc; @@ -3497,7 +3491,7 @@ Tcl_GetCommandName( return ""; } - return (const char *) Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); + return (const char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); } /* @@ -3547,8 +3541,7 @@ Tcl_GetCommandFullName( } } if (cmdPtr->hPtr != NULL) { - name = (char *) - Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); + name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); Tcl_AppendToObj(objPtr, name, -1); } } @@ -3673,7 +3666,7 @@ Tcl_DeleteCommandFromToken( if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; /* CallCommandTraces() does not cmdPtr, that's - * done just before Tcl_DeleteCommandFromToken() returns */ + * done just before Tcl_DeleteCommandFromToken() returns */ CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); /* @@ -3927,11 +3920,11 @@ CallCommandTraces( static int CancelEvalProc( - void *clientData, /* Interp to cancel the script in progress. */ + void *clientData, /* Interp to cancel the script in progress. */ TCL_UNUSED(Tcl_Interp *), int code) /* Current return code from command. */ { - CancelInfo *cancelInfo = (CancelInfo *) clientData; + CancelInfo *cancelInfo = (CancelInfo *)clientData; Interp *iPtr; if (cancelInfo != NULL) { @@ -4005,7 +3998,7 @@ CancelEvalProc( void TclCleanupCommand( - Command *cmdPtr) /* Points to the Command structure to + Command *cmdPtr) /* Points to the Command structure to * be freed. */ { if (cmdPtr->refCount-- <= 1) { @@ -4157,7 +4150,7 @@ Tcl_Canceled( */ if (!TclCanceled(iPtr)) { - return TCL_OK; + return TCL_OK; } /* @@ -4178,7 +4171,7 @@ Tcl_Canceled( */ if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) { - return TCL_OK; + return TCL_OK; } /* @@ -4187,34 +4180,34 @@ Tcl_Canceled( */ if (flags & TCL_LEAVE_ERR_MSG) { - const char *id, *message = NULL; - Tcl_Size length; + const char *id, *message = NULL; + Tcl_Size length; - /* - * Setup errorCode variables so that we can differentiate between - * being canceled and unwound. - */ + /* + * Setup errorCode variables so that we can differentiate between + * being canceled and unwound. + */ - if (iPtr->asyncCancelMsg != NULL) { - message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); - } else { - length = 0; - } + if (iPtr->asyncCancelMsg != NULL) { + message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); + } else { + length = 0; + } - if (iPtr->flags & TCL_CANCEL_UNWIND) { - id = "IUNWIND"; - if (length == 0) { - message = "eval unwound"; - } - } else { - id = "ICANCEL"; - if (length == 0) { - message = "eval canceled"; - } - } + if (iPtr->flags & TCL_CANCEL_UNWIND) { + id = "IUNWIND"; + if (length == 0) { + message = "eval unwound"; + } + } else { + id = "ICANCEL"; + if (length == 0) { + message = "eval canceled"; + } + } - Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); - Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); + Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); } /* @@ -4253,7 +4246,7 @@ Tcl_CancelEval( * script. */ Tcl_Obj *resultObjPtr, /* The script cancellation error message or * NULL for a default error message. */ - void *clientData, /* Passed to CancelEvalProc. */ + void *clientData, /* Passed to CancelEvalProc. */ int flags) /* Collection of OR-ed bits that control * the cancellation of the script. Only * TCL_CANCEL_UNWIND is currently @@ -4284,7 +4277,7 @@ Tcl_CancelEval( goto done; } - cancelInfo = (CancelInfo *) Tcl_GetHashValue(hPtr); + cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); /* * Populate information needed by the interpreter thread to fulfill the @@ -4296,8 +4289,7 @@ Tcl_CancelEval( if (resultObjPtr != NULL) { result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); - cancelInfo->result = (char *) - Tcl_Realloc(cancelInfo->result, cancelInfo->length); + cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result,cancelInfo->length); memcpy(cancelInfo->result, result, cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { @@ -4400,7 +4392,7 @@ TclNREvalObjv( */ if (iPtr->deferredCallbacks) { - iPtr->deferredCallbacks = NULL; + iPtr->deferredCallbacks = NULL; } else { TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); } @@ -4417,10 +4409,10 @@ EvalObjvCore( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - Command *cmdPtr = NULL, *preCmdPtr = (Command *) data[0]; + Command *cmdPtr = NULL, *preCmdPtr = (Command *)data[0]; int flags = PTR2INT(data[1]); int objc = PTR2INT(data[2]); - Tcl_Obj **objv = (Tcl_Obj **) data[3]; + Tcl_Obj **objv = (Tcl_Obj **)data[3]; Interp *iPtr = (Interp *) interp; Namespace *lookupNsPtr = NULL; int enterTracesDone = 0; @@ -4488,13 +4480,13 @@ EvalObjvCore( assert(cmdPtr == NULL); if (preCmdPtr) { /* - * Caller gave it to us. - */ + * Caller gave it to us. + */ if (!(preCmdPtr->flags & CMD_DEAD)) { /* - * So long as it exists, use it. - */ + * So long as it exists, use it. + */ cmdPtr = preCmdPtr; } else if (flags & TCL_EVAL_NORESOLVE) { @@ -4519,7 +4511,7 @@ EvalObjvCore( if (enterTracesDone || iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { Tcl_Obj *commandPtr = TclGetSourceFromFrame( - flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, + flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, objc, objv); Tcl_IncrRefCount(commandPtr); @@ -4562,7 +4554,7 @@ EvalObjvCore( cmdPtr->refCount++; TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc), - commandPtr, cmdPtr, objv); + commandPtr, cmdPtr, objv); } TclNRAddCallback(interp, Dispatch, @@ -4577,10 +4569,10 @@ Dispatch( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *) data[0]; + Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0]; void *clientData = data[1]; Tcl_Size objc = PTR2INT(data[2]); - Tcl_Obj **objv = (Tcl_Obj **) data[3]; + Tcl_Obj **objv = (Tcl_Obj **)data[3]; Interp *iPtr = (Interp *) interp; #ifdef USE_DTRACE @@ -4625,8 +4617,8 @@ TclNRRunCallbacks( * are to be run. */ { while (TOP_CB(interp) != rootPtr) { - NRE_callback *callbackPtr = TOP_CB(interp); - Tcl_NRPostProc *procPtr = callbackPtr->procPtr; + NRE_callback *callbackPtr = TOP_CB(interp); + Tcl_NRPostProc *procPtr = callbackPtr->procPtr; TOP_CB(interp) = callbackPtr->nextPtr; result = procPtr(callbackPtr->data, interp, result); @@ -4646,12 +4638,12 @@ NRCommand( iPtr->numLevels--; - /* - * If there is a tailcall, schedule it next - */ + /* + * If there is a tailcall, schedule it next + */ if (data[1] && (data[1] != INT2PTR(1))) { - listPtr = (Tcl_Obj *) data[1]; + listPtr = (Tcl_Obj *)data[1]; data[1] = NULL; TclNRAddCallback(interp, TclNRTailcallEval, listPtr, NULL, NULL, NULL); @@ -4745,7 +4737,7 @@ TEOV_RestoreVarFrame( Tcl_Interp *interp, int result) { - ((Interp *) interp)->varFramePtr = (CallFrame *) data[0]; + ((Interp *) interp)->varFramePtr = (CallFrame *)data[0]; return result; } @@ -4789,7 +4781,7 @@ TEOV_Error( const char *cmdString; Tcl_Size cmdLen; int objc = PTR2INT(data[0]); - Tcl_Obj **objv = (Tcl_Obj **) data[1]; + Tcl_Obj **objv = (Tcl_Obj **)data[1]; if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { /* @@ -4851,7 +4843,7 @@ TEOV_NotFound( TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; - newObjv = (Tcl_Obj **) TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); + newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); /* * Copy command prefix from unknown handler and add on the real command's @@ -4863,7 +4855,7 @@ TEOV_NotFound( newObjv[i] = handlerObjv[i]; Tcl_IncrRefCount(newObjv[i]); } - memcpy(newObjv + handlerObjc, objv, sizeof(Tcl_Obj *) * objc); + memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc); /* * Look up and invoke the handler (by recursive call to this function). If @@ -4878,9 +4870,9 @@ TEOV_NotFound( cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr); if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid command name \"%s\"", TclGetString(objv[0]))); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", - TclGetString(objv[0]), (char *)NULL); + "invalid command name \"%s\"", TclGetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", + TclGetString(objv[0]), (char *)NULL); /* * Release any resources we locked and allocated during the handler @@ -4912,8 +4904,8 @@ TEOV_NotFoundCallback( { Interp *iPtr = (Interp *) interp; int objc = PTR2INT(data[0]); - Tcl_Obj **objv = (Tcl_Obj **) data[1]; - Namespace *savedNsPtr = (Namespace *) data[2]; + Tcl_Obj **objv = (Tcl_Obj **)data[1]; + Namespace *savedNsPtr = (Namespace *)data[2]; int i; @@ -4993,9 +4985,9 @@ TEOV_RunLeaveTraces( Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; int objc = PTR2INT(data[0]); - Tcl_Obj *commandPtr = (Tcl_Obj *) data[1]; - Command *cmdPtr = (Command *) data[2]; - Tcl_Obj **objv = (Tcl_Obj **) data[3]; + Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; + Command *cmdPtr = (Command *)data[2]; + Tcl_Obj **objv = (Tcl_Obj **)data[3]; Tcl_Size length; const char *command = TclGetStringFromObj(commandPtr, &length); @@ -5079,7 +5071,7 @@ Tcl_EvalTokensStandard( * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - Tcl_Size count) /* Number of tokens to consider at tokenPtr. + Tcl_Size count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, @@ -5134,7 +5126,7 @@ TclEvalEx( * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ Tcl_Size line, /* The line the script starts on. */ - Tcl_Size *clNextOuter, /* Information about an outer context for */ + Tcl_Size *clNextOuter, /* Information about an outer context for */ const char *outerScript) /* continuation line data. This is set only in * TclSubstTokens(), to properly handle * [...]-nested commands. The 'outerScript' @@ -5170,18 +5162,15 @@ TclEvalEx( * state has been allocated while evaluating * the script, so that it can be freed * properly if an error occurs. */ - Tcl_Parse *parsePtr = (Tcl_Parse *) - TclStackAlloc(interp, sizeof(Tcl_Parse)); - CmdFrame *eeFramePtr = (CmdFrame *) - TclStackAlloc(interp, sizeof(CmdFrame)); + Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); + CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); Tcl_Obj **stackObjArray = (Tcl_Obj **) TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); - int *expandStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int)); - Tcl_Size *linesStack = (Tcl_Size *) - TclStackAlloc(interp, minObjs * sizeof(Tcl_Size)); + int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int)); + Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size)); /* TIP #280 Structures for tracking of command * locations. */ - Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible + Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible * continuation lines. Initialized only if the * caller gave us a table of locations to * track, via scriptCLLocPtr. It always refers @@ -5314,11 +5303,9 @@ TclEvalEx( */ if (numWords > minObjs) { - expand = (int *) Tcl_Alloc(numWords * sizeof(int)); - objvSpace = (Tcl_Obj **) - Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); - lineSpace = (Tcl_Size *) - Tcl_Alloc(numWords * sizeof(Tcl_Size)); + expand = (int *)Tcl_Alloc(numWords * sizeof(int)); + objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); + lineSpace = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size)); } expandRequested = 0; objv = objvSpace; @@ -5327,7 +5314,7 @@ TclEvalEx( iPtr->cmdFramePtr = eeFramePtr->nextPtr; for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr; objectsUsed < numWords; - objectsUsed++, tokenPtr += tokenPtr->numComponents + 1) { + objectsUsed++, tokenPtr += tokenPtr->numComponents+1) { Tcl_Size additionalObjsCount; /* @@ -5350,7 +5337,7 @@ TclEvalEx( iPtr->evalFlags |= TCL_EVAL_FILE; } - code = TclSubstTokens(interp, tokenPtr + 1, + code = TclSubstTokens(interp, tokenPtr+1, tokenPtr->numComponents, NULL, wordLine, wordCLNext, outerScript); @@ -5372,8 +5359,7 @@ TclEvalEx( */ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (expanding word %" TCL_SIZE_MODIFIER "d)", - objectsUsed)); + "\n (expanding word %" TCL_SIZE_MODIFIER "d)", objectsUsed)); Tcl_DecrRefCount(objv[objectsUsed]); break; } @@ -5416,10 +5402,9 @@ TclEvalEx( Tcl_Size objIdx = objectsNeeded - 1; if ((numWords > minObjs) || (objectsNeeded > minObjs)) { - objv = objvSpace = (Tcl_Obj **) - Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); - lines = lineSpace = (Tcl_Size *) - Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size)); + objv = objvSpace = + (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); + lines = lineSpace = (Tcl_Size *)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size)); } objectsUsed = 0; @@ -5443,7 +5428,7 @@ TclEvalEx( objectsUsed++; } } - objv += objIdx + 1; + objv += objIdx+1; if (copy != stackObjArray) { Tcl_Free(copy); @@ -5740,7 +5725,7 @@ TclArgumentEnter( * and initialize references. */ - cfwPtr = (CFWord *) Tcl_Alloc(sizeof(CFWord)); + cfwPtr = (CFWord *)Tcl_Alloc(sizeof(CFWord)); cfwPtr->framePtr = cfPtr; cfwPtr->word = i; cfwPtr->refCount = 1; @@ -5751,7 +5736,7 @@ TclArgumentEnter( * relevant. Just remember the reference to prevent early removal. */ - cfwPtr = (CFWord *) Tcl_GetHashValue(hPtr); + cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); cfwPtr->refCount++; } } @@ -5788,12 +5773,13 @@ TclArgumentRelease( for (i = 1; i < objc; i++) { CFWord *cfwPtr; - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]); + Tcl_HashEntry *hPtr = + Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]); if (!hPtr) { continue; } - cfwPtr = (CFWord *) Tcl_GetHashValue(hPtr); + cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); if (cfwPtr->refCount-- > 1) { continue; @@ -5839,12 +5825,13 @@ TclArgumentBCEnter( ECL *ePtr; CFWordBC *lastPtr = NULL; Interp *iPtr = (Interp *) interp; - Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); + Tcl_HashEntry *hePtr = + Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); if (!hePtr) { return; } - eclPtr = (ExtCmdLoc *) Tcl_GetHashValue(hePtr); + eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr); ePtr = &eclPtr->loc[cmd]; /* @@ -5861,7 +5848,7 @@ TclArgumentBCEnter( */ if (ePtr->nline != objc) { - return; + return; } /* @@ -5879,8 +5866,8 @@ TclArgumentBCEnter( if (ePtr->line[word] >= 0) { int isNew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, - objv[word], &isNew); - CFWordBC *cfwPtr = (CFWordBC *) Tcl_Alloc(sizeof(CFWordBC)); + objv[word], &isNew); + CFWordBC *cfwPtr = (CFWordBC *)Tcl_Alloc(sizeof(CFWordBC)); cfwPtr->framePtr = cfPtr; cfwPtr->obj = objv[word]; @@ -5904,7 +5891,7 @@ TclArgumentBCEnter( * information in the new structure. */ - cfwPtr->prevPtr = (CFWordBC *) Tcl_GetHashValue(hPtr); + cfwPtr->prevPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, cfwPtr); @@ -5946,7 +5933,7 @@ TclArgumentBCRelease( CFWordBC *nextPtr = cfwPtr->nextPtr; Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, cfwPtr->obj); - CFWordBC *xPtr = (CFWordBC *) Tcl_GetHashValue(hPtr); + CFWordBC *xPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); if (xPtr != cfwPtr) { Tcl_Panic("TclArgumentBC Enter/Release Mismatch"); @@ -6012,7 +5999,7 @@ TclArgumentGet( hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, obj); if (hPtr) { - CFWord *cfwPtr = (CFWord *) Tcl_GetHashValue(hPtr); + CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); *wordPtr = cfwPtr->word; *cfPtrPtr = cfwPtr->framePtr; @@ -6026,7 +6013,7 @@ TclArgumentGet( hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, obj); if (hPtr) { - CFWordBC *cfwPtr = (CFWordBC *) Tcl_GetHashValue(hPtr); + CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); framePtr = cfwPtr->framePtr; framePtr->data.tebc.pc = (char *) (((ByteCode *) @@ -6069,7 +6056,7 @@ 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 + 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 @@ -6082,7 +6069,7 @@ 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 + 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 @@ -6101,7 +6088,7 @@ 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 + 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 @@ -6165,7 +6152,7 @@ TclNREvalObjEx( * should be pushed, as needed by alias and ensemble redirections. */ - eoFramePtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame)); + eoFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); eoFramePtr->nline = 0; eoFramePtr->line = NULL; @@ -6186,7 +6173,7 @@ TclNREvalObjEx( } TclMarkTailcall(interp); - TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, + TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); TclListObjGetElements(NULL, listPtr, &objc, &objv); @@ -6207,9 +6194,9 @@ TclNREvalObjEx( * iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ - if (TclInterpReady(interp) != TCL_OK) { - return TCL_ERROR; - } + if (TclInterpReady(interp) != TCL_OK) { + return TCL_ERROR; + } if (flags & TCL_EVAL_GLOBAL) { savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; @@ -6219,7 +6206,7 @@ TclNREvalObjEx( TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr, objPtr, INT2PTR(allowExceptions), NULL); - return TclNRExecuteByteCode(interp, codePtr); + return TclNRExecuteByteCode(interp, codePtr); } { @@ -6274,8 +6261,8 @@ TEOEx_ByteCodeCallback( int result) { Interp *iPtr = (Interp *) interp; - CallFrame *savedVarFramePtr = (CallFrame *) data[0]; - Tcl_Obj *objPtr = (Tcl_Obj *) data[1]; + CallFrame *savedVarFramePtr = (CallFrame *)data[0]; + Tcl_Obj *objPtr = (Tcl_Obj *)data[1]; int allowExceptions = PTR2INT(data[2]); if (iPtr->numLevels == 0) { @@ -6320,9 +6307,9 @@ TEOEx_ListCallback( int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *listPtr = (Tcl_Obj *) data[0]; - CmdFrame *eoFramePtr = (CmdFrame *) data[1]; - Tcl_Obj *objPtr = (Tcl_Obj *) data[2]; + Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; + CmdFrame *eoFramePtr = (CmdFrame *)data[1]; + Tcl_Obj *objPtr = (Tcl_Obj *)data[2]; /* * Remove the cmdFrame @@ -6502,7 +6489,7 @@ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ long *ptr) /* Where to store long result. */ { Tcl_Obj *resultPtr; @@ -6515,7 +6502,7 @@ Tcl_ExprLongObj( return TCL_ERROR; } - if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type) != TCL_OK) { + if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) { return TCL_ERROR; } @@ -6549,7 +6536,7 @@ int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ double *ptr) /* Where to store double result. */ { Tcl_Obj *resultPtr; @@ -6625,7 +6612,7 @@ int TclObjInvokeNamespace( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ Tcl_Namespace *nsPtr, /* The namespace to use. */ @@ -6669,7 +6656,7 @@ int TclObjInvoke( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ int flags) /* Combination of flags controlling the call: @@ -6681,7 +6668,7 @@ TclObjInvoke( } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal argument vector", -1)); + "illegal argument vector", -1)); return TCL_ERROR; } if ((flags & TCL_INVOKE_HIDDEN) == 0) { @@ -6710,12 +6697,12 @@ TclNRInvoke( } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid hidden command name \"%s\"", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, - (char *)NULL); + "invalid hidden command name \"%s\"", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, + (char *)NULL); return TCL_ERROR; } - cmdPtr = (Command *) Tcl_GetHashValue(hPtr); + cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Avoid the exception-handling brain damage when numLevels == 0 @@ -6739,7 +6726,7 @@ NRPostInvoke( Tcl_Interp *interp, int result) { - Interp *iPtr = (Interp *) interp; + Interp *iPtr = (Interp *)interp; iPtr->numLevels--; return result; @@ -7200,7 +7187,7 @@ ExprIsqrtFunc( negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "square root of negative argument", -1)); + "square root of negative argument", -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", (char *)NULL); return TCL_ERROR; @@ -7260,7 +7247,7 @@ ExprSqrtFunc( static int ExprUnaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes one double argument and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the @@ -7270,7 +7257,7 @@ ExprUnaryFunc( { int code; double d; - BuiltinUnaryFunc *func = (BuiltinUnaryFunc *) clientData; + double (*func)(double) = (double (*)(double)) clientData; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); @@ -7324,7 +7311,7 @@ CheckDoubleResult( static int ExprBinaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes two double arguments and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the @@ -7334,7 +7321,7 @@ ExprBinaryFunc( { int code; double d1, d2; - BuiltinBinaryFunc *func = (BuiltinBinaryFunc *) clientData; + double (*func)(double, double) = (double (*)(double, double)) clientData; if (objc != 3) { MathFuncWrongNumArgs(interp, 3, objc, objv); @@ -7410,14 +7397,13 @@ ExprAbsFunc( Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); return TCL_OK; } - bytes++; - numBytes--; + bytes++; numBytes--; } } goto unChanged; } else if (l == WIDE_MIN) { if (sizeof(Tcl_WideInt) > sizeof(int64_t)) { - Tcl_WideUInt ul = -(Tcl_WideUInt) WIDE_MIN; + Tcl_WideUInt ul = -(Tcl_WideUInt)WIDE_MIN; if (mp_init(&big) != MP_OKAY || mp_unpack(&big, 1, 1, sizeof(Tcl_WideInt), 0, 0, &ul) != MP_OKAY) { return TCL_ERROR; @@ -7553,7 +7539,7 @@ ExprIntFunc( if (type == TCL_NUMBER_DOUBLE) { d = *((const double *) ptr); - if ((d >= (double) WIDE_MAX) || (d <= (double) WIDE_MIN)) { + if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) { mp_int big; if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { @@ -7629,20 +7615,20 @@ ExprMaxMinFunc( } res = objv[1]; for (i = 1; i < objc; i++) { - if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { - return TCL_ERROR; - } - if (type == TCL_NUMBER_NAN) { - /* - * Get the error message for NaN. - */ - - Tcl_GetDoubleFromObj(interp, objv[i], &d); - return TCL_ERROR; - } - if (TclCompareTwoNumbers(objv[i], res) == op) { - res = objv[i]; - } + if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type == TCL_NUMBER_NAN) { + /* + * Get the error message for NaN. + */ + + Tcl_GetDoubleFromObj(interp, objv[i], &d); + return TCL_ERROR; + } + if (TclCompareTwoNumbers(objv[i], res) == op) { + res = objv[i]; + } } Tcl_SetObjResult(interp, res); @@ -7698,7 +7684,7 @@ ExprRandFunc( * take into consideration the thread this interp is running in. */ - iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread()) * 4093U; + iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread())*4093U; /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. @@ -7795,7 +7781,7 @@ ExprRoundFunc( } else if (fractPart >= 0.5) { max--; } - if ((intPart >= (double) max) || (intPart <= (double) min)) { + if ((intPart >= (double)max) || (intPart <= (double)min)) { mp_int big; mp_err err = MP_OKAY; @@ -7814,7 +7800,7 @@ ExprRoundFunc( Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; } else { - Tcl_WideInt result = (Tcl_WideInt) intPart; + Tcl_WideInt result = (Tcl_WideInt)intPart; if (fractPart <= -0.5) { result--; @@ -7895,8 +7881,8 @@ ExprSrandFunc( * This page contains the functions that implement all of the built-in * math functions for classifying IEEE doubles. * - * These have to be a little bit careful while Tcl_GetDoubleFromObj() - * rejects NaN values, which these functions *explicitly* accept. + * These have to be a little bit careful while Tcl_GetDoubleFromObj() + * rejects NaN values, which these functions *explicitly* accept. * * Results: * Each function returns TCL_OK if it succeeds and pushes an Tcl object @@ -7930,16 +7916,16 @@ ClassifyDouble( * Hence we define those here. */ #ifndef FP_NAN -# define FP_NAN 1 /* Value is NaN */ -# define FP_INFINITE 2 /* Value is an infinity */ -# define FP_ZERO 3 /* Value is a zero */ -# define FP_NORMAL 4 /* Value is a normal float */ -# define FP_SUBNORMAL 5 /* Value has lost accuracy */ +# define FP_NAN 1 /* Value is NaN */ +# define FP_INFINITE 2 /* Value is an infinity */ +# define FP_ZERO 3 /* Value is a zero */ +# define FP_NORMAL 4 /* Value is a normal float */ +# define FP_SUBNORMAL 5 /* Value has lost accuracy */ #endif /* !FP_NAN */ #if TCL_FPCLASSIFY_MODE == 3 return __builtin_fpclassify( - FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); + FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); #elif TCL_FPCLASSIFY_MODE == 2 /* * We assume this hack is only needed on little-endian systems. @@ -7949,27 +7935,27 @@ ClassifyDouble( */ union { - double d; /* Interpret as double */ - struct { - unsigned int low; /* Lower 32 bits */ - unsigned int high; /* Upper 32 bits */ - } w; /* Interpret as unsigned integer words */ - } doubleMeaning; /* So we can look at the representation of a - * double directly. Platform (i.e., processor) - * specific; this is for x86 (and most other - * little-endian processors, but those are - * untested). */ + double d; /* Interpret as double */ + struct { + unsigned int low; /* Lower 32 bits */ + unsigned int high; /* Upper 32 bits */ + } w; /* Interpret as unsigned integer words */ + } doubleMeaning; /* So we can look at the representation of a + * double directly. Platform (i.e., processor) + * specific; this is for x86 (and most other + * little-endian processors, but those are + * untested). */ unsigned int exponent, mantissaLow, mantissaHigh; - /* The pieces extracted from the double. */ - int zeroMantissa; /* Was the mantissa zero? That's special. */ + /* The pieces extracted from the double. */ + int zeroMantissa; /* Was the mantissa zero? That's special. */ /* * Shifts and masks to use with the doubleMeaning variable above. */ -#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ -#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ -#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ +#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ +#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ +#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ /* * Extract the exponent (11 bits) and mantissa (52 bits). Note that we @@ -7988,43 +7974,43 @@ ClassifyDouble( switch (exponent) { case 0: - /* - * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. - */ + /* + * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. + */ - return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; + return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; case EXPONENT_MASK: - /* - * When the exponent is all ones, it's an INF or a NAN. - */ + /* + * When the exponent is all ones, it's an INF or a NAN. + */ - return zeroMantissa ? FP_INFINITE : FP_NAN; + return zeroMantissa ? FP_INFINITE : FP_NAN; default: - /* - * Everything else is a NORMAL double precision float. - */ + /* + * Everything else is a NORMAL double precision float. + */ - return FP_NORMAL; + return FP_NORMAL; } #elif TCL_FPCLASSIFY_MODE == 1 switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: - return FP_ZERO; + return FP_ZERO; case _FPCLASS_NN: case _FPCLASS_PN: - return FP_NORMAL; + return FP_NORMAL; case _FPCLASS_ND: case _FPCLASS_PD: - return FP_SUBNORMAL; + return FP_SUBNORMAL; case _FPCLASS_NINF: case _FPCLASS_PINF: - return FP_INFINITE; + return FP_INFINITE; default: - Tcl_Panic("result of _fpclass() outside documented range!"); + Tcl_Panic("result of _fpclass() outside documented range!"); case _FPCLASS_QNAN: case _FPCLASS_SNAN: - return FP_NAN; + return FP_NAN; } #else /* TCL_FPCLASSIFY_MODE not in (0..3) */ #error "unknown or unexpected TCL_FPCLASSIFY_MODE" @@ -8050,14 +8036,14 @@ ExprIsFiniteFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - type = ClassifyDouble(d); - result = (type != FP_INFINITE && type != FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + type = ClassifyDouble(d); + result = (type != FP_INFINITE && type != FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8081,13 +8067,13 @@ ExprIsInfinityFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_INFINITE); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_INFINITE); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8111,13 +8097,13 @@ ExprIsNaNFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8141,13 +8127,13 @@ ExprIsNormalFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8171,13 +8157,13 @@ ExprIsSubnormalFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_SUBNORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_SUBNORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8201,23 +8187,23 @@ ExprIsUnorderedFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result = 1; + result = 1; } else { - d = *((const double *) ptr); - result = (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result = (ClassifyDouble(d) == FP_NAN); } if (Tcl_GetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result |= 1; + result |= 1; } else { - d = *((const double *) ptr); - result |= (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result |= (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); @@ -8238,39 +8224,39 @@ FloatClassifyObjCmd( int type; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); + Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - goto gotNaN; + goto gotNaN; } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } switch (ClassifyDouble(d)) { case FP_INFINITE: - TclNewLiteralStringObj(objPtr, "infinite"); - break; + TclNewLiteralStringObj(objPtr, "infinite"); + break; case FP_NAN: gotNaN: - TclNewLiteralStringObj(objPtr, "nan"); - break; + TclNewLiteralStringObj(objPtr, "nan"); + break; case FP_NORMAL: - TclNewLiteralStringObj(objPtr, "normal"); - break; + TclNewLiteralStringObj(objPtr, "normal"); + break; case FP_SUBNORMAL: - TclNewLiteralStringObj(objPtr, "subnormal"); - break; + TclNewLiteralStringObj(objPtr, "subnormal"); + break; case FP_ZERO: - TclNewLiteralStringObj(objPtr, "zero"); - break; + TclNewLiteralStringObj(objPtr, "zero"); + break; default: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to classify number: %f", d)); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to classify number: %f", d)); + return TCL_ERROR; } Tcl_SetObjResult(interp, objPtr); return TCL_OK; @@ -8303,10 +8289,10 @@ MathFuncWrongNumArgs( const char *name = TclGetString(objv[0]); const char *tail = name + strlen(name); - while (tail > name + 1) { + while (tail > name+1) { tail--; if (*tail == ':' && tail[-1] == ':') { - name = tail + 1; + name = tail+1; break; } } @@ -8501,14 +8487,14 @@ wrapperNRObjProc( int objc, Tcl_Obj *const objv[]) { - CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; clientData = info->clientData; Tcl_ObjCmdProc2 *proc = info->proc; Tcl_Free(info); if (objc < 0) { objc = -1; } - return proc(clientData, interp, (Tcl_Size) objc, objv); + return proc(clientData, interp, (Tcl_Size)objc, objv); } int @@ -8525,8 +8511,7 @@ Tcl_NRCallObjProc2( } NRE_callback *rootPtr = TOP_CB(interp); - CmdWrapperInfo *info = (CmdWrapperInfo *) - Tcl_Alloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->clientData = clientData; info->proc = objProc; @@ -8570,8 +8555,7 @@ cmdWrapperNreProc( int objc, Tcl_Obj *const objv[]) { - CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; - + CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; if (objc < 0) { objc = -1; } @@ -8591,15 +8575,13 @@ Tcl_NRCreateCommand2( * calls. */ Tcl_ObjCmdProc2 *nreProc, /* Object-based function to associate with * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { - CmdWrapperInfo *info = (CmdWrapperInfo *) - Tcl_Alloc(sizeof(CmdWrapperInfo)); - + CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = proc; info->clientData = clientData; info->nreProc = nreProc; @@ -8624,7 +8606,7 @@ Tcl_NRCreateCommand( * calls. */ Tcl_ObjCmdProc *nreProc, /* Object-based function to associate with * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when @@ -8632,7 +8614,7 @@ Tcl_NRCreateCommand( { Command *cmdPtr = (Command *) Tcl_CreateObjCommand(interp, cmdName, proc, clientData, - deleteProc); + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; @@ -8649,8 +8631,8 @@ TclNRCreateCommandInNs( Tcl_CmdDeleteProc *deleteProc) { Command *cmdPtr = (Command *) - TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, - deleteProc); + TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; @@ -8673,7 +8655,7 @@ int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - Tcl_Size objc, /* Number of words in command. */ + Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the @@ -8732,8 +8714,8 @@ TclMarkTailcall( if (iPtr->deferredCallbacks == NULL) { TclNRAddCallback(interp, NRCommand, NULL, NULL, - NULL, NULL); - iPtr->deferredCallbacks = TOP_CB(interp); + NULL, NULL); + iPtr->deferredCallbacks = TOP_CB(interp); } } @@ -8780,12 +8762,12 @@ TclSetTailcall( NRE_callback *runPtr; for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { - if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { - break; - } + if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { + break; + } } if (!runPtr) { - Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); + Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); } runPtr->data[1] = listPtr; } @@ -8821,9 +8803,9 @@ TclNRTailcallObjCmd( } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tailcall can only be called from a proc, lambda or method", -1)); - Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "tailcall can only be called from a proc, lambda or method", -1)); + Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); return TCL_ERROR; } @@ -8833,8 +8815,8 @@ TclNRTailcallObjCmd( */ if (iPtr->varFramePtr->tailcallPtr) { - Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); - iPtr->varFramePtr->tailcallPtr = NULL; + Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); + iPtr->varFramePtr->tailcallPtr = NULL; } /* @@ -8844,19 +8826,19 @@ TclNRTailcallObjCmd( */ if (objc > 1) { - Tcl_Obj *listPtr, *nsObjPtr; - Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; + Tcl_Obj *listPtr, *nsObjPtr; + Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; - /* - * The tailcall data is in a Tcl list: the first element is the - * namespace, the rest the command to be tailcalled. - */ + /* + * The tailcall data is in a Tcl list: the first element is the + * namespace, the rest the command to be tailcalled. + */ - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); - listPtr = Tcl_NewListObj(objc, objv); + nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); + listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); - iPtr->varFramePtr->tailcallPtr = listPtr; + iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } @@ -8878,7 +8860,7 @@ TclNRTailcallEval( int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *listPtr = (Tcl_Obj *) data[0], *nsObjPtr; + Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr; Tcl_Namespace *nsPtr; Tcl_Size objc; Tcl_Obj **objv; @@ -8891,13 +8873,13 @@ TclNRTailcallEval( } if (result != TCL_OK) { - /* - * Tailcall execution was preempted, eg by an intervening catch or by - * a now-gone namespace: cleanup and return. - */ + /* + * Tailcall execution was preempted, eg by an intervening catch or by + * a now-gone namespace: cleanup and return. + */ Tcl_DecrRefCount(listPtr); - return result; + return result; } /* @@ -8907,7 +8889,7 @@ TclNRTailcallEval( TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; - return TclNREvalObjv(interp, objc - 1, objv + 1, 0, NULL); + return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL); } int @@ -8984,7 +8966,7 @@ TclNRYieldObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yield can only be called in a coroutine", -1)); + "yield can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } @@ -8995,7 +8977,7 @@ TclNRYieldObjCmd( NRE_ASSERT(!COR_IS_SUSPENDED(corPtr)); TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - clientData, NULL, NULL); + clientData, NULL, NULL); return TCL_OK; } @@ -9017,17 +8999,17 @@ TclNRYieldToObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto can only be called in a coroutine", -1)); + "yieldto can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } if (((Namespace *) nsPtr)->flags & NS_DYING) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto called in deleted namespace", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", (char *)NULL); - return TCL_ERROR; + return TCL_ERROR; } /* @@ -9059,7 +9041,7 @@ RewindCoroutineCallback( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - return Tcl_RestoreInterpState(interp, (Tcl_InterpState) data[0]); + return Tcl_RestoreInterpState(interp, (Tcl_InterpState)data[0]); } static int @@ -9084,7 +9066,7 @@ static void DeleteCoroutine( void *clientData) { - CoroutineData *corPtr = (CoroutineData *) clientData; + CoroutineData *corPtr = (CoroutineData *)clientData; Tcl_Interp *interp = corPtr->eePtr->interp; NRE_callback *rootPtr = TOP_CB(interp); @@ -9099,7 +9081,7 @@ NRCoroutineCallerCallback( Tcl_Interp *interp, int result) { - CoroutineData *corPtr = (CoroutineData *) data[0]; + CoroutineData *corPtr = (CoroutineData *)data[0]; Command *cmdPtr = corPtr->cmdPtr; /* @@ -9145,7 +9127,7 @@ NRCoroutineExitCallback( Tcl_Interp *interp, int result) { - CoroutineData *corPtr = (CoroutineData *) data[0]; + CoroutineData *corPtr = (CoroutineData *)data[0]; Command *cmdPtr = corPtr->cmdPtr; /* @@ -9192,14 +9174,14 @@ NRCoroutineExitCallback( * * TclNRCoroutineActivateCallback -- * - * This is the workhorse for coroutines: it implements both yield and - * resume. + * This is the workhorse for coroutines: it implements both yield and + * resume. * - * It is important that both be implemented in the same callback: the - * detection of the impossibility to suspend due to a busy C-stack relies - * on the precise position of a local variable in the stack. We do not - * want the compiler to play tricks on us, either by moving things around - * or inlining. + * It is important that both be implemented in the same callback: the + * detection of the impossibility to suspend due to a busy C-stack relies + * on the precise position of a local variable in the stack. We do not + * want the compiler to play tricks on us, either by moving things around + * or inlining. * *---------------------------------------------------------------------- */ @@ -9210,46 +9192,46 @@ TclNRCoroutineActivateCallback( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - CoroutineData *corPtr = (CoroutineData *) data[0]; + CoroutineData *corPtr = (CoroutineData *)data[0]; void *stackLevel = TclGetCStackPtr(); if (!corPtr->stackLevel) { - /* - * -- Coroutine is suspended -- - * Push the callback to restore the caller's context on yield or - * return. - */ - - TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); - - /* - * Record the stackLevel at which the resume is happening, then swap - * the interp's environment to make it suitable to run this coroutine. - */ - - corPtr->stackLevel = stackLevel; - Tcl_Size numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = iPtr->numLevels; - - SAVE_CONTEXT(corPtr->caller); - corPtr->callerEEPtr = iPtr->execEnvPtr; - RESTORE_CONTEXT(corPtr->running); - iPtr->execEnvPtr = corPtr->eePtr; - iPtr->numLevels += numLevels; + /* + * -- Coroutine is suspended -- + * Push the callback to restore the caller's context on yield or + * return. + */ + + TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, + NULL, NULL, NULL); + + /* + * Record the stackLevel at which the resume is happening, then swap + * the interp's environment to make it suitable to run this coroutine. + */ + + corPtr->stackLevel = stackLevel; + Tcl_Size numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = iPtr->numLevels; + + SAVE_CONTEXT(corPtr->caller); + corPtr->callerEEPtr = iPtr->execEnvPtr; + RESTORE_CONTEXT(corPtr->running); + iPtr->execEnvPtr = corPtr->eePtr; + iPtr->numLevels += numLevels; } else { - /* - * Coroutine is active: yield - */ + /* + * Coroutine is active: yield + */ - if (corPtr->stackLevel != stackLevel) { + if (corPtr->stackLevel != stackLevel) { NRE_callback *runPtr; iPtr->execEnvPtr = corPtr->callerEEPtr; if (corPtr->yieldPtr) { for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { if (runPtr->data[1] == corPtr->yieldPtr) { - Tcl_DecrRefCount((Tcl_Obj *) runPtr->data[1]); + Tcl_DecrRefCount((Tcl_Obj *)runPtr->data[1]); runPtr->data[1] = NULL; corPtr->yieldPtr = NULL; break; @@ -9258,30 +9240,31 @@ TclNRCoroutineActivateCallback( } iPtr->execEnvPtr = corPtr->eePtr; - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot yield: C stack busy", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", - (char *)NULL); - return TCL_ERROR; - } - void *type = data[1]; - if (type == CORO_ACTIVATE_YIELD) { - corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; - } else if (type == CORO_ACTIVATE_YIELDM) { - corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; - } else { - Tcl_Panic("Yield received an option which is not implemented"); - } + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot yield: C stack busy", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", + (char *)NULL); + return TCL_ERROR; + } + + void *type = data[1]; + if (type == CORO_ACTIVATE_YIELD) { + corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; + } else if (type == CORO_ACTIVATE_YIELDM) { + corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; + } else { + Tcl_Panic("Yield received an option which is not implemented"); + } corPtr->yieldPtr = NULL; - corPtr->stackLevel = NULL; + corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return TCL_OK; @@ -9292,7 +9275,7 @@ TclNRCoroutineActivateCallback( * * TclNREvalList -- * - * Callback to invoke command as list, used in order to delayed + * Callback to invoke command as list, used in order to delayed * processing of canonical list command in sane environment. * *---------------------------------------------------------------------- @@ -9306,7 +9289,7 @@ TclNREvalList( { Tcl_Size objc; Tcl_Obj **objv; - Tcl_Obj *listPtr = (Tcl_Obj *) data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; Tcl_IncrRefCount(listPtr); @@ -9321,7 +9304,7 @@ TclNREvalList( * * CoroTypeObjCmd -- * - * Implementation of [::tcl::unsupported::corotype] command. + * Implementation of [::tcl::unsupported::corotype] command. * *---------------------------------------------------------------------- */ @@ -9347,11 +9330,11 @@ CoroTypeObjCmd( cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only get coroutine type of a coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objv[1]), (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only get coroutine type of a coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objv[1]), (char *)NULL); + return TCL_ERROR; } /* @@ -9359,10 +9342,10 @@ CoroTypeObjCmd( * future. */ - corPtr = (CoroutineData *) cmdPtr->objClientData; + corPtr = (CoroutineData *)cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); + return TCL_OK; } /* @@ -9372,16 +9355,16 @@ CoroTypeObjCmd( switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); + return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); + return TCL_OK; default: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown coroutine type", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unknown coroutine type", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); + return TCL_ERROR; } } @@ -9390,7 +9373,7 @@ CoroTypeObjCmd( * * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd -- * - * Implementation of [coroinject] and [coroprobe] commands. + * Implementation of [coroinject] and [coroprobe] commands. * *---------------------------------------------------------------------- */ @@ -9408,12 +9391,12 @@ GetCoroutineFromObj( Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objPtr), (char *) NULL); - return NULL; + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objPtr), (char *)NULL); + return NULL; } - return (CoroutineData *) cmdPtr->objClientData; + return (CoroutineData *)cmdPtr->objClientData; } static int @@ -9436,15 +9419,15 @@ TclNRCoroInjectObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9455,7 +9438,7 @@ TclNRCoroInjectObjCmd( ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; @@ -9481,16 +9464,16 @@ TclNRCoroProbeObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a probe command into a coroutine"); + "can only inject a probe command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a probe command into a suspended coroutine", - -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a probe command into a suspended coroutine", + -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9501,7 +9484,7 @@ TclNRCoroProbeObjCmd( ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); iPtr->execEnvPtr = savedEEPtr; /* @@ -9512,7 +9495,7 @@ TclNRCoroProbeObjCmd( */ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); /* * Record the stackLevel at which the resume is happening, then swap @@ -9540,18 +9523,18 @@ TclNRCoroProbeObjCmd( * * InjectHandler, InjectHandlerPostProc -- * - * Part of the implementation of [coroinject] and [coroprobe]. These are - * run inside the context of the coroutine being injected/probed into. + * Part of the implementation of [coroinject] and [coroprobe]. These are + * run inside the context of the coroutine being injected/probed into. * - * InjectHandler runs a script (possibly adding arguments) in the context - * of the coroutine. The script is specified as a one-shot list (with - * reference count equal to 1) in data[1]. This function also arranges - * for InjectHandlerPostProc to be the part that runs after the script - * completes. + * InjectHandler runs a script (possibly adding arguments) in the context + * of the coroutine. The script is specified as a one-shot list (with + * reference count equal to 1) in data[1]. This function also arranges + * for InjectHandlerPostProc to be the part that runs after the script + * completes. * - * InjectHandlerPostProc cleans up after InjectHandler (deleting the - * list) and, for the [coroprobe] command *only*, yields back to the - * caller context (i.e., where [coroprobe] was run). + * InjectHandlerPostProc cleans up after InjectHandler (deleting the + * list) and, for the [coroprobe] command *only*, yields back to the + * caller context (i.e., where [coroprobe] was run). *s *---------------------------------------------------------------------- */ @@ -9562,8 +9545,8 @@ InjectHandler( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - CoroutineData *corPtr = (CoroutineData *) data[0]; - Tcl_Obj *listPtr = (Tcl_Obj *) data[1]; + CoroutineData *corPtr = (CoroutineData *)data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; Tcl_Size objc; @@ -9598,7 +9581,7 @@ InjectHandler( Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr, - INT2PTR(nargs), isProbe); + INT2PTR(nargs), isProbe); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } @@ -9609,8 +9592,8 @@ InjectHandlerPostCall( Tcl_Interp *interp, int result) { - CoroutineData *corPtr = (CoroutineData *) data[0]; - Tcl_Obj *listPtr = (Tcl_Obj *) data[1]; + CoroutineData *corPtr = (CoroutineData *)data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; @@ -9628,16 +9611,16 @@ InjectHandlerPostCall( */ if (isProbe) { - if (result == TCL_ERROR) { - Tcl_AddErrorInfo(interp, - "\n (injected coroutine probe command)"); - } - corPtr->nargs = nargs; - corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + if (result == TCL_ERROR) { + Tcl_AddErrorInfo(interp, + "\n (injected coroutine probe command)"); + } + corPtr->nargs = nargs; + corPtr->stackLevel = NULL; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return result; } @@ -9647,7 +9630,7 @@ InjectHandlerPostCall( * * NRInjectObjCmd -- * - * Implementation of [::tcl::unsupported::inject] command. + * Implementation of [::tcl::unsupported::inject] command. * *---------------------------------------------------------------------- */ @@ -9673,15 +9656,15 @@ NRInjectObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9690,8 +9673,8 @@ NRInjectObjCmd( */ iPtr->execEnvPtr = corPtr->eePtr; - TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc - 2, objv + 2), - NULL, NULL, NULL); + TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2), + NULL, NULL, NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; @@ -9704,12 +9687,12 @@ TclNRInterpCoroutine( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - CoroutineData *corPtr = (CoroutineData *) clientData; + CoroutineData *corPtr = (CoroutineData *)clientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "coroutine \"%s\" is already running", - TclGetString(objv[0]))); + "coroutine \"%s\" is already running", + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", (char *)NULL); return TCL_ERROR; } @@ -9722,31 +9705,31 @@ TclNRInterpCoroutine( switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - if (objc == 2) { - Tcl_SetObjResult(interp, objv[1]); - } else if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); - return TCL_ERROR; - } - break; + if (objc == 2) { + Tcl_SetObjResult(interp, objv[1]); + } else if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); + return TCL_ERROR; + } + break; default: - if (corPtr->nargs + 1 != objc) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong coro nargs; how did we get here? " - "not implemented!", -1)); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); - return TCL_ERROR; - } - /* fallthrough */ + if (corPtr->nargs + 1 != objc) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong coro nargs; how did we get here? " + "not implemented!", -1)); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); + return TCL_ERROR; + } + /* fallthrough */ case COROUTINE_ARGUMENTS_ARBITRARY: - if (objc > 1) { - Tcl_SetObjResult(interp, Tcl_NewListObj(objc - 1, objv + 1)); - } - break; + if (objc > 1) { + Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); + } + break; } TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } @@ -9755,8 +9738,8 @@ TclNRInterpCoroutine( * * TclNRCoroutineObjCmd -- * - * Implementation of [coroutine] command; see documentation for - * description of what this does. + * Implementation of [coroutine] command; see documentation for + * description of what this does. * *---------------------------------------------------------------------- */ @@ -9772,7 +9755,7 @@ TclNRCoroutineObjCmd( CoroutineData *corPtr; const char *procName, *simpleName; Namespace *nsPtr, *altNsPtr, *cxtNsPtr, - *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp); + *inNsPtr = (Namespace *)TclGetCurrentNamespace(interp); Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr; if (objc < 3) { @@ -9786,16 +9769,16 @@ TclNRCoroutineObjCmd( if (nsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": unknown namespace", - procName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); + "can't create procedure \"%s\": unknown namespace", + procName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); return TCL_ERROR; } if (simpleName == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": bad procedure name", - procName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); + "can't create procedure \"%s\": bad procedure name", + procName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); return TCL_ERROR; } @@ -9804,10 +9787,10 @@ TclNRCoroutineObjCmd( * struct and create the corresponding command. */ - corPtr = (CoroutineData *) Tcl_Alloc(sizeof(CoroutineData)); + corPtr = (CoroutineData *)Tcl_Alloc(sizeof(CoroutineData)); cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName, - (Tcl_Namespace *) nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, + (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine); corPtr->cmdPtr = cmdPtr; @@ -9826,8 +9809,7 @@ TclNRCoroutineObjCmd( Tcl_HashSearch hSearch; Tcl_HashEntry *hePtr; - corPtr->lineLABCPtr = (Tcl_HashTable *) - Tcl_Alloc(sizeof(Tcl_HashTable)); + corPtr->lineLABCPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch); @@ -9888,7 +9870,7 @@ TclNRCoroutineObjCmd( */ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } diff --git a/generic/tclBinary.c b/generic/tclBinary.c index d95452b..329cfe2 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -557,6 +557,7 @@ TclNarrowToBytes( Tcl_IncrRefCount(objPtr); return objPtr; } + /* *---------------------------------------------------------------------- diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index a95fc83..1c12106 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -719,6 +719,7 @@ Tcl_AttemptDbCkrealloc( Tcl_DbCkfree(ptr, file, line); return newPtr; } + /* *---------------------------------------------------------------------- @@ -1009,6 +1010,7 @@ Tcl_InitMemory( Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL); } + #else /* TCL_MEM_DEBUG */ /* This is the !TCL_MEM_DEBUG case */ @@ -1016,6 +1018,7 @@ Tcl_InitMemory( #undef Tcl_InitMemory #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory + /* *---------------------------------------------------------------------- @@ -1250,11 +1253,11 @@ TclDumpMemoryInfo( */ void * TclAllocElemsEx( - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if - * non-NULL. Only modified on success */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored + here if non-NULL. Only modified on success */ { void *ptr = TclAttemptReallocElemsEx( NULL, elemCount, elemSize, leadSize, capacityPtr); @@ -1285,13 +1288,13 @@ TclAllocElemsEx( */ void * TclAttemptReallocElemsEx( - void *oldPtr, /* Pointer to memory block to reallocate or - * NULL to indicate this is a new allocation */ - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if - * non-NULL. Only modified on success */ + void *oldPtr, /* Pointer to memory block to reallocate or + * NULL to indicate this is a new allocation */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored + here if non-NULL. Only modified on success */ { void *ptr; Tcl_Size limit; @@ -1355,12 +1358,12 @@ TclAttemptReallocElemsEx( */ void * TclReallocElemsEx( - void *oldPtr, /* Pointer to memory block to reallocate */ - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if - * non-NULL. Only modified on success */ + void *oldPtr, /* Pointer to memory block to reallocate */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored + here if non-NULL. Only modified on success */ { void *ptr = TclAttemptReallocElemsEx( oldPtr, elemCount, elemSize, leadSize, capacityPtr); diff --git a/generic/tclClock.c b/generic/tclClock.c index 412f616..2cfa4a5 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1964,6 +1964,7 @@ ConvertLocalToUTC( ltzoc->tzOffset = fields->tzOffset; } + /* check DST-hole: if retrieved seconds is out of range */ if (ltzoc->rangesVal[0] > seconds || seconds >= ltzoc->rangesVal[1]) { dstHole: @@ -2899,6 +2900,7 @@ GetJulianDayFromEraYearMonthDay( *---------------------------------------------------------------------- */ + void GetJulianDayFromEraYearDay( TclDateFields *fields, /* Date to convert */ @@ -4248,6 +4250,7 @@ ClockCalcRelTime( return TCL_OK; } + /*---------------------------------------------------------------------- * @@ -4306,6 +4309,8 @@ ClockWeekdaysOffs( return offs; } + + /*---------------------------------------------------------------------- * diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index ab5fbb0..288271b 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -425,13 +425,14 @@ TclInitEncodingCmd( */ static int EncodingConvertParseOptions( - Tcl_Interp *interp, /* For error messages. May be NULL */ - int objc, /* Number of arguments */ - Tcl_Obj *const objv[], /* Argument objects as passed to command. */ - Tcl_Encoding *encPtr, /* Where to store the encoding */ - Tcl_Obj **dataObjPtr, /* Where to store ptr to Tcl_Obj containing data */ - int *profilePtr, /* Bit mask of encoding option profile */ - Tcl_Obj **failVarPtr) /* Where to store -failindex option value */ + Tcl_Interp *interp, /* For error messages. May be NULL */ + int objc, /* Number of arguments */ + Tcl_Obj *const objv[], /* Argument objects as passed to command. */ + Tcl_Encoding *encPtr, /* Where to store the encoding */ + Tcl_Obj **dataObjPtr, /* Where to store ptr to Tcl_Obj containing data */ + int *profilePtr, /* Bit mask of encoding option profile */ + Tcl_Obj **failVarPtr /* Where to store -failindex option value */ +) { static const char *const options[] = {"-profile", "-failindex", NULL}; enum convertfromOptions { PROFILE, FAILINDEX } optIndex; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 37c9822..c46ab60 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -5290,6 +5290,7 @@ SortCompare( return 0; } + objPtr1 = elemPtr1->collationKey.objValuePtr; objPtr2 = elemPtr2->collationKey.objValuePtr; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index bad58f6..99a97ad 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -657,6 +657,7 @@ TclCompileCatchCmd( } ExceptionRangeEnds(envPtr, range); + /* * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result, * and jump around the "error case" code. @@ -678,6 +679,7 @@ TclCompileCatchCmd( TclEmitOpcode( INST_POP, envPtr); } + /* Stack at this point is empty */ TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); @@ -789,6 +791,7 @@ TclCompileClockClicksCmd( } return TCL_OK; } + /*---------------------------------------------------------------------- * @@ -2848,6 +2851,7 @@ CompileEachloopCmd( int varIndex; Tcl_Size length; + Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); bytes = TclGetStringFromObj(varNameObj, &length); varIndex = LocalScalar(bytes, length, envPtr); diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index bc37155..98a39f9 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -101,6 +101,7 @@ const AuxDataType tclJumptableInfoType = { if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));} #define INVOKE(name) \ TclEmitInvoke(envPtr,INST_##name) + /* *---------------------------------------------------------------------- diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 5c46afd..c9f9ec5 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -1924,7 +1924,7 @@ ParseLexeme( unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ Tcl_Obj **literalPtr) /* Write corresponding literal value to this - * storage, if non-NULL. */ + storage, if non-NULL. */ { const char *end; int ch; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 18d5ed7..5bbbb8f 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -89,20 +89,20 @@ typedef enum { typedef struct { ExceptionRangeType type; /* The kind of ExceptionRange. */ - Tcl_Size nestingLevel; /* Static depth of the exception range. Used + Tcl_Size nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range * surrounding a PC at runtime. */ - Tcl_Size codeOffset; /* Offset of the first instruction byte of the + Tcl_Size codeOffset; /* Offset of the first instruction byte of the * code range. */ - Tcl_Size numCodeBytes; /* Number of bytes in the code range. */ - Tcl_Size breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC + Tcl_Size numCodeBytes; /* Number of bytes in the code range. */ + Tcl_Size breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC * offset for a break command in the range. */ - Tcl_Size continueOffset; /* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, - * the target PC offset for a continue command - * in the code range. Otherwise, ignore this + Tcl_Size continueOffset; /* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, the + * target PC offset for a continue command in + * the code range. Otherwise, ignore this * range when processing a continue * command. */ - Tcl_Size catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC + Tcl_Size catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC * offset for any "exception" in range. */ } ExceptionRange; @@ -118,11 +118,11 @@ typedef struct ExceptionAux { * one (see [for] next-clause) then we must * not pick up the range when scanning for a * target to continue to. */ - Tcl_Size stackDepth; /* The stack depth at the point where the + Tcl_Size stackDepth; /* The stack depth at the point where the * exception range was created. This is used * to calculate the number of POPs required to * restore the stack to its prior state. */ - Tcl_Size expandTarget; /* The number of expansions expected on the + Tcl_Size expandTarget; /* The number of expansions expected on the * auxData stack at the time the loop starts; * we can't currently discard them except by * doing INST_INVOKE_EXPANDED; this is a known @@ -135,25 +135,23 @@ typedef struct ExceptionAux { Tcl_Size numBreakTargets; /* The number of [break]s that want to be * targeted to the place where this loop * exception will be bound to. */ - TCL_HASH_TYPE *breakTargets;/* The offsets of the INST_JUMP4 instructions + TCL_HASH_TYPE *breakTargets; /* The offsets of the INST_JUMP4 instructions * issued by the [break]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numBreakTargets==0, this is NULL. */ Tcl_Size allocBreakTargets; /* The size of the breakTargets array. */ - Tcl_Size numContinueTargets;/* The number of [continue]s that want to be + Tcl_Size numContinueTargets; /* The number of [continue]s that want to be * targeted to the place where this loop * exception will be bound to. */ - TCL_HASH_TYPE *continueTargets; - /* The offsets of the INST_JUMP4 instructions + TCL_HASH_TYPE *continueTargets; /* The offsets of the INST_JUMP4 instructions * issued by the [continue]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numContinueTargets==0, this is NULL. */ - Tcl_Size allocContinueTargets; - /* The size of the continueTargets array. */ + Tcl_Size allocContinueTargets; /* The size of the continueTargets array. */ } ExceptionAux; /* @@ -165,10 +163,10 @@ typedef struct ExceptionAux { */ typedef struct { - Tcl_Size codeOffset; /* Offset of first byte of command code. */ - Tcl_Size numCodeBytes; /* Number of bytes for command's code. */ + Tcl_Size codeOffset; /* Offset of first byte of command code. */ + Tcl_Size numCodeBytes; /* Number of bytes for command's code. */ Tcl_Size srcOffset; /* Offset of first char of the command. */ - Tcl_Size numSrcBytes; /* Number of command source chars. */ + Tcl_Size numSrcBytes; /* Number of command source chars. */ } CmdLocation; /* @@ -184,10 +182,10 @@ typedef struct { typedef struct { Tcl_Size srcOffset; /* Command location to find the entry. */ - Tcl_Size nline; /* Number of words in the command */ - Tcl_Size *line; /* Line information for all words in the + Tcl_Size nline; /* Number of words in the command */ + Tcl_Size *line; /* Line information for all words in the * command. */ - Tcl_Size **next; /* Transient information used by the compiler + Tcl_Size **next; /* Transient information used by the compiler * for tracking of hidden continuation * lines. */ } ECL; @@ -200,8 +198,8 @@ typedef struct { Tcl_Obj *path; /* Path of the sourced file the command is * in. */ ECL *loc; /* Command word locations (lines). */ - Tcl_Size nloc; /* Number of allocated entries in 'loc'. */ - Tcl_Size nuloc; /* Number of used entries in 'loc'. */ + Tcl_Size nloc; /* Number of allocated entries in 'loc'. */ + Tcl_Size nuloc; /* Number of used entries in 'loc'. */ } ExtCmdLoc; /* @@ -219,11 +217,11 @@ typedef struct { * the AuxData structure. */ -typedef void * (AuxDataDupProc) (void *clientData); -typedef void (AuxDataFreeProc) (void *clientData); -typedef void (AuxDataPrintProc) (void *clientData, - Tcl_Obj *appendObj, struct ByteCode *codePtr, - TCL_HASH_TYPE pcOffset); +typedef void *(AuxDataDupProc) (void *clientData); +typedef void (AuxDataFreeProc) (void *clientData); +typedef void (AuxDataPrintProc)(void *clientData, + Tcl_Obj *appendObj, struct ByteCode *codePtr, + TCL_HASH_TYPE pcOffset); /* * We define a separate AuxDataType struct to hold type-related information @@ -268,7 +266,7 @@ typedef struct AuxDataType { typedef struct AuxData { const AuxDataType *type; /* Pointer to the AuxData type associated with * this ClientData. */ - void *clientData; /* The compilation data itself. */ + void *clientData; /* The compilation data itself. */ } AuxData; /* @@ -292,23 +290,21 @@ typedef struct CompileEnv { * SetByteCodeFromAny. This pointer is not * owned by the CompileEnv and must not be * freed or changed by it. */ - Tcl_Size numSrcBytes; /* Number of bytes in source. */ + Tcl_Size numSrcBytes; /* Number of bytes in source. */ Proc *procPtr; /* If a procedure is being compiled, a pointer * to its Proc structure; otherwise NULL. Used * to compile local variables. Set from * information provided by ObjInterpProc in * tclProc.c. */ - Tcl_Size numCommands; /* Number of commands compiled. */ - Tcl_Size exceptDepth; /* Current exception range nesting level; - * TCL_INDEX_NONE if not in any range - * currently. */ - Tcl_Size maxExceptDepth; /* Max nesting level of exception ranges; - * TCL_INDEX_NONE if no ranges have been - * compiled. */ - Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to + Tcl_Size numCommands; /* Number of commands compiled. */ + Tcl_Size exceptDepth; /* Current exception range nesting level; TCL_INDEX_NONE + * if not in any range currently. */ + Tcl_Size maxExceptDepth; /* Max nesting level of exception ranges; TCL_INDEX_NONE + * if no ranges have been compiled. */ + Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to * execute the code. Set by compilation * procedures before returning. */ - Tcl_Size currStackDepth; /* Current stack depth. */ + Tcl_Size currStackDepth; /* Current stack depth. */ LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl * objects referenced by this compiled code. * Indexed by the string representations of @@ -337,7 +333,7 @@ typedef struct CompileEnv { * exceptArrayNext is the number of ranges and * (exceptArrayNext-1) is the index of the * current range's array entry. */ - Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array + Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array * entry. */ #if TCL_MAJOR_VERSION < 9 int mallocedExceptArray; @@ -383,7 +379,7 @@ typedef struct CompileEnv { /* TIP #280 */ ExtCmdLoc *extCmdMapPtr; /* Extended command location information for * 'info frame'. */ - Tcl_Size line; /* First line of the script, based on the + Tcl_Size line; /* First line of the script, based on the * invoking context, then the line of the * command currently compiled. */ int atCmdStart; /* Flag to say whether an INST_START_CMD @@ -392,11 +388,11 @@ typedef struct CompileEnv { * inefficient. If set to 2, that instruction * should not be issued at all (by the generic * part of the command compiler). */ - Tcl_Size expandCount; /* Number of INST_EXPAND_START instructions + Tcl_Size expandCount; /* Number of INST_EXPAND_START instructions * encountered that have not yet been paired * with a corresponding * INST_INVOKE_EXPANDED. */ - Tcl_Size *clNext; /* If not NULL, it refers to the next slot in + Tcl_Size *clNext; /* If not NULL, it refers to the next slot in * clLoc to check for an invisible * continuation line. */ } CompileEnv; @@ -431,7 +427,7 @@ typedef struct ByteCode { * procs are specific to an interpreter so the * code emitted will depend on the * interpreter. */ - Tcl_Size compileEpoch; /* Value of iPtr->compileEpoch when this + Tcl_Size compileEpoch; /* Value of iPtr->compileEpoch when this * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ @@ -463,17 +459,17 @@ typedef struct ByteCode { * itself. Does not include heap space for * literal Tcl objects or storage referenced * by AuxData entries. */ - Tcl_Size numCommands; /* Number of commands compiled. */ - Tcl_Size numSrcBytes; /* Number of source bytes compiled. */ - Tcl_Size numCodeBytes; /* Number of code bytes. */ - Tcl_Size numLitObjects; /* Number of objects in literal array. */ + Tcl_Size numCommands; /* Number of commands compiled. */ + Tcl_Size numSrcBytes; /* Number of source bytes compiled. */ + Tcl_Size numCodeBytes; /* Number of code bytes. */ + Tcl_Size numLitObjects; /* Number of objects in literal array. */ Tcl_Size numExceptRanges; /* Number of ExceptionRange array elems. */ Tcl_Size numAuxDataItems; /* Number of AuxData items. */ - Tcl_Size numCmdLocBytes; /* Number of bytes needed for encoded command + Tcl_Size numCmdLocBytes; /* Number of bytes needed for encoded command * location information. */ - Tcl_Size maxExceptDepth; /* Maximum nesting level of ExceptionRanges; + Tcl_Size maxExceptDepth; /* Maximum nesting level of ExceptionRanges; * TCL_INDEX_NONE if no ranges were compiled. */ - Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to + Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to * execute the code. */ unsigned char *codeStart; /* Points to the first byte of the code. This * is just after the final ByteCode member @@ -529,7 +525,7 @@ typedef struct ByteCode { #endif /* TCL_COMPILE_STATS */ } ByteCode; -#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr) \ +#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (codePtr); \ @@ -537,11 +533,13 @@ typedef struct ByteCode { Tcl_StoreInternalRep((objPtr), (typePtr), &ir); \ } while (0) -#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \ + + +#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), (typePtr)); \ - (codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), (typePtr)); \ + (codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -831,11 +829,11 @@ enum TclInstruction { INST_DICT_GET_DEF, - /* TIP 461 */ - INST_STR_LT, - INST_STR_GT, - INST_STR_LE, - INST_STR_GE, + /* TIP 461 */ + INST_STR_LT, + INST_STR_GT, + INST_STR_LE, + INST_STR_GE, INST_LREPLACE4, @@ -970,8 +968,8 @@ typedef struct JumpFixup { typedef struct JumpFixupArray { JumpFixup *fixup; /* Points to start of jump fixup array. */ - Tcl_Size next; /* Index of next free array entry. */ - Tcl_Size end; /* Index of last usable entry in array. */ + Tcl_Size next; /* Index of next free array entry. */ + Tcl_Size end; /* Index of last usable entry in array. */ int mallocedArray; /* 1 if array was expanded and fixups points * into the heap, else 0. */ JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES]; @@ -987,8 +985,7 @@ typedef struct JumpFixupArray { typedef struct ForeachVarList { Tcl_Size numVars; /* The number of variables in the list. */ - Tcl_Size varIndexes[TCLFLEXARRAY]; - /* An array of the indexes ("slot numbers") + Tcl_Size varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers") * for each variable in the procedure's array * of local variables. Only scalar variables * are supported. The actual size of this @@ -1006,14 +1003,13 @@ typedef struct ForeachVarList { typedef struct ForeachInfo { Tcl_Size numLists; /* The number of both the variable and value * lists of the foreach command. */ - Tcl_Size firstValueTemp; /* Index of the first temp var in a proc frame + Tcl_Size firstValueTemp; /* Index of the first temp var in a proc frame * used to point to a value list. */ - Tcl_Size loopCtTemp; /* Index of temp var in a proc frame holding + Tcl_Size loopCtTemp; /* Index of temp var in a proc frame holding * the loop's iteration count. Used to * determine next value list element to assign * each loop var. */ - ForeachVarList *varLists[TCLFLEXARRAY]; - /* An array of pointers to ForeachVarList + ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList * structures describing each var list. The * actual size of this field will be large * enough to numVars indexes. THIS MUST BE THE @@ -1044,8 +1040,7 @@ MODULE_SCOPE const AuxDataType tclJumptableInfoType; typedef struct { Tcl_Size length; /* Size of array */ - Tcl_Size varIndices[TCLFLEXARRAY]; - /* Array of variable indices to manage when + Tcl_Size varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when * processing the start and end of a [dict * update]. There is really more than one * entry, and the structure is allocated to @@ -1205,13 +1200,14 @@ MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, Tcl_Size length, const unsigned char *pc, Tcl_Obj **tosPtr); -MODULE_SCOPE Tcl_Obj * TclGetInnerContext(Tcl_Interp *interp, +MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); -MODULE_SCOPE Tcl_Obj * TclNewInstNameObj(unsigned char inst); +MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); MODULE_SCOPE int TclPushProcCallFrame(void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int isLambda); #endif /* TCL_MAJOR_VERSION > 8 */ + /* *---------------------------------------------------------------- @@ -1234,66 +1230,58 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, #define LITERAL_UNSHARED 0x04 /* - * Adjust the stack requirements. Manually used in cases where the stack - * effect cannot be computed from the opcode and its operands, but is still - * known at compile time. + * Macro used to manually adjust the stack requirements; used in cases where + * the stack effect cannot be computed from the opcode and its operands, but + * is still known at compile time. + * + * void TclAdjustStackDepth(int delta, CompileEnv *envPtr); */ -static inline void -TclAdjustStackDepth( - int delta, - CompileEnv *envPtr) -{ - if (delta < 0) { - if ((int) envPtr->maxStackDepth < (int) envPtr->currStackDepth) { - envPtr->maxStackDepth = envPtr->currStackDepth; - } - } - envPtr->currStackDepth += delta; -} -#define TclGetStackDepth(envPtr) \ +#define TclAdjustStackDepth(delta, envPtr) \ + do { \ + if ((delta) < 0) { \ + if ((int)(envPtr)->maxStackDepth < (int)(envPtr)->currStackDepth) { \ + (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \ + } \ + } \ + (envPtr)->currStackDepth += (delta); \ + } while (0) + +#define TclGetStackDepth(envPtr) \ ((envPtr)->currStackDepth) -#define TclSetStackDepth(depth, envPtr) \ +#define TclSetStackDepth(depth, envPtr) \ (envPtr)->currStackDepth = (depth) -/* - * Verify that the current stack depth is what we think it should be. When - * this is wrong, code generation is broken! - */ -static inline void -TclCheckStackDepth( - size_t depth, - CompileEnv *envPtr) -{ - if (depth != (size_t) envPtr->currStackDepth) { - Tcl_Panic("bad stack depth computations: " - "is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u", - (size_t) envPtr->currStackDepth, depth); - } -} +#define TclCheckStackDepth(depth, envPtr) \ + do { \ + size_t _dd = (depth); \ + if (_dd != (size_t)(envPtr)->currStackDepth) { \ + Tcl_Panic("bad stack depth computations: is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u", \ + (size_t)(envPtr)->currStackDepth, _dd); \ + } \ + } while (0) /* - * Update the stack requirements based on the instruction definition. It is - * called by the macros TclEmitOpCode, TclEmitInst1 and TclEmitInst4. + * Macro used to update the stack requirements. It is called by the macros + * TclEmitOpCode, TclEmitInst1 and TclEmitInst4. * Remark that the very last instruction of a bytecode always reduces the * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always * updated. + * + * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr); */ -static inline void -TclUpdateStackReqs( - unsigned char op, - int i, - CompileEnv *envPtr) -{ - int delta = tclInstructionTable[op].stackEffect; - if (delta) { - if (delta == INT_MIN) { - delta = 1 - i; - } - TclAdjustStackDepth(delta, envPtr); - } -} + +#define TclUpdateStackReqs(op, i, envPtr) \ + do { \ + int _delta = tclInstructionTable[(op)].stackEffect; \ + if (_delta) { \ + if (_delta == INT_MIN) { \ + _delta = 1 - (i); \ + } \ + TclAdjustStackDepth(_delta, envPtr); \ + } \ + } while (0) /* * Macros used to update the flag that indicates if we are at the start of a @@ -1303,8 +1291,8 @@ TclUpdateStackReqs( */ #define TclUpdateAtCmdStart(op, envPtr) \ - if ((envPtr)->atCmdStart < 2) { \ - (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \ + if ((envPtr)->atCmdStart < 2) { \ + (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \ } /* @@ -1315,13 +1303,13 @@ TclUpdateStackReqs( */ #define TclEmitOpcode(op, envPtr) \ - do { \ - if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - TclUpdateAtCmdStart(op, envPtr); \ - TclUpdateStackReqs(op, 0, envPtr); \ + do { \ + if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op); \ + TclUpdateAtCmdStart(op, envPtr); \ + TclUpdateStackReqs(op, 0, envPtr); \ } while (0) /* @@ -1377,21 +1365,21 @@ TclUpdateStackReqs( } while (0) #define TclEmitInstInt4(op, i, envPtr) \ - do { \ - if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 24); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 16); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 8); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) ); \ - TclUpdateAtCmdStart(op, envPtr); \ - TclUpdateStackReqs(op, i, envPtr); \ + do { \ + if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 24); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 16); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 8); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) ); \ + TclUpdateAtCmdStart(op, envPtr); \ + TclUpdateStackReqs(op, i, envPtr); \ } while (0) /* @@ -1404,13 +1392,13 @@ TclUpdateStackReqs( */ #define TclEmitPush(objIndex, envPtr) \ - do { \ - int _objIndexCopy = (objIndex); \ - if (_objIndexCopy <= 255) { \ - TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ - } else { \ - TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ - } \ + do { \ + int _objIndexCopy = (objIndex); \ + if (_objIndexCopy <= 255) { \ + TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ + } else { \ + TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ + } \ } while (0) /* @@ -1426,11 +1414,11 @@ TclUpdateStackReqs( *(p) = (unsigned char) ((unsigned int) (i)) #define TclStoreInt4AtPtr(i, p) \ - do { \ - *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ - *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ - *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ - *(p+3) = (unsigned char) ((unsigned int) (i) ); \ + do { \ + *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ + *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ + *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ + *(p+3) = (unsigned char) ((unsigned int) (i) ); \ } while (0) /* @@ -1443,15 +1431,15 @@ TclUpdateStackReqs( */ #define TclUpdateInstInt1AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt1AtPtr((i), ((pc)+1)); \ + do { \ + *(pc) = (unsigned char) (op); \ + TclStoreInt1AtPtr((i), ((pc)+1)); \ } while (0) #define TclUpdateInstInt4AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt4AtPtr((i), ((pc)+1)); \ + do { \ + *(pc) = (unsigned char) (op); \ + TclStoreInt4AtPtr((i), ((pc)+1)); \ } while (0) /* @@ -1498,17 +1486,17 @@ TclUpdateStackReqs( #endif #define TclGetInt4AtPtr(p) \ - ((int) ((TclGetUInt1AtPtr(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ + ((int) ((TclGetUInt1AtPtr(p) << 24) | \ + (*((p)+1) << 16) | \ + (*((p)+2) << 8) | \ (*((p)+3)))) #define TclGetUInt1AtPtr(p) \ ((unsigned int) *(p)) #define TclGetUInt4AtPtr(p) \ - ((unsigned int) ((*(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ + ((unsigned int) ((*(p) << 24) | \ + (*((p)+1) << 16) | \ + (*((p)+2) << 8) | \ (*((p)+3)))) /* @@ -1529,7 +1517,7 @@ TclUpdateStackReqs( * static void BODY(Tcl_Token *tokenPtr, int word); */ -#define BODY(tokenPtr, word) \ +#define BODY(tokenPtr, word) \ SetLineInformation((word)); \ TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \ envPtr) @@ -1827,14 +1815,14 @@ MODULE_SCOPE void TclDTraceOpenDebugLog(void); MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *argsi); #define TCL_DTRACE_DEBUG_LOG() \ - int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \ - int tclDTraceDebugIndent = 0; \ - FILE *tclDTraceDebugLog = NULL; \ - void TclDTraceOpenDebugLog(void) { \ - char n[35]; \ + int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \ + int tclDTraceDebugIndent = 0; \ + FILE *tclDTraceDebugLog = NULL; \ + void TclDTraceOpenDebugLog(void) { \ + char n[35]; \ snprintf(n, sizeof(n), "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \ - (size_t) getpid()); \ - tclDTraceDebugLog = fopen(n, "a"); \ + (size_t) getpid()); \ + tclDTraceDebugLog = fopen(n, "a"); \ } #define TclDTraceDbgMsg(p, m, ...) \ @@ -1861,10 +1849,10 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *args #define TCL_DTRACE_PROC_ARGS_ENABLED() 1 #define TCL_DTRACE_PROC_INFO_ENABLED() 1 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \ - tclDTraceDebugIndent++; \ + tclDTraceDebugIndent++; \ TclDTraceDbgMsg("-> proc-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2) #define TCL_DTRACE_PROC_RETURN(a0, a1) \ - TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ + TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \ TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3) @@ -1881,10 +1869,10 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *args #define TCL_DTRACE_CMD_ARGS_ENABLED() 1 #define TCL_DTRACE_CMD_INFO_ENABLED() 1 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \ - tclDTraceDebugIndent++; \ + tclDTraceDebugIndent++; \ TclDTraceDbgMsg("-> cmd-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2) #define TCL_DTRACE_CMD_RETURN(a0, a1) \ - TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ + TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \ TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3) diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 5a64ff8..7a8783c 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -45,20 +45,21 @@ static const Tcl_ObjType instNameType = { TCL_OBJTYPE_V0 }; -#define InstNameSetInternalRep(objPtr, inst) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.wideValue = (inst); \ +#define InstNameSetInternalRep(objPtr, inst) \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.wideValue = (inst); \ Tcl_StoreInternalRep((objPtr), &instNameType, &ir); \ } while (0) -#define InstNameGetInternalRep(objPtr, inst) \ - do { \ +#define InstNameGetInternalRep(objPtr, inst) \ + do { \ const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &instNameType); \ - assert(irPtr != NULL); \ - (inst) = irPtr->wideValue; \ + irPtr = TclFetchInternalRep((objPtr), &instNameType); \ + assert(irPtr != NULL); \ + (inst) = irPtr->wideValue; \ } while (0) + /* *---------------------------------------------------------------------- diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 0844303..4b1ef16 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -258,6 +258,7 @@ static Tcl_EncodingConvertProc UtfToUtfProc; static Tcl_EncodingConvertProc Iso88591FromUtfProc; static Tcl_EncodingConvertProc Iso88591ToUtfProc; + /* * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field * of the internalrep. This should help the lifetime of encodings be more useful. @@ -273,20 +274,21 @@ static const Tcl_ObjType encodingType = { TCL_OBJTYPE_V0 }; -#define EncodingSetInternalRep(objPtr, encoding) \ +#define EncodingSetInternalRep(objPtr, encoding) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (encoding); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \ + Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \ } while (0) -#define EncodingGetInternalRep(objPtr, encoding) \ +#define EncodingGetInternalRep(objPtr, encoding) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep ((objPtr), &encodingType); \ - (encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \ + (encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) + /* *---------------------------------------------------------------------- @@ -1110,6 +1112,7 @@ Tcl_ExternalToUtfDString( NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL); return Tcl_DStringValue(dstPtr); } + /* *------------------------------------------------------------------------- @@ -1155,14 +1158,14 @@ Tcl_ExternalToUtfDStringEx( Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - Tcl_Size srcLen, /* Source string length in bytes, or < 0 for + Tcl_Size srcLen, /* Source string length in bytes, or < 0 for * encoding-specific string length. */ int flags, /* Conversion control flags. */ Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ Tcl_Size *errorLocPtr) /* Where to store the error location - * (or TCL_INDEX_NONE if no error). May - * be NULL. */ + (or TCL_INDEX_NONE if no error). May + be NULL. */ { char *dst; Tcl_EncodingState state; @@ -1427,6 +1430,7 @@ Tcl_UtfToExternalDString( NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL); return Tcl_DStringValue(dstPtr); } + /* *------------------------------------------------------------------------- @@ -1477,8 +1481,8 @@ Tcl_UtfToExternalDStringEx( Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ Tcl_Size *errorLocPtr) /* Where to store the error location - * (or TCL_INDEX_NONE if no error). May - * be NULL. */ + (or TCL_INDEX_NONE if no error). May + be NULL. */ { char *dst; Tcl_EncodingState state; diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 0128672..ef4e946 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -20,9 +20,9 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #if defined(_WIN32) # define tenviron _wenviron # define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ - (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr))) + (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr))) # define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ - (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr))) + (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr))) # define techar WCHAR # ifdef USE_PUTENV # define putenv(env) _wputenv((const wchar_t *)env) @@ -30,12 +30,13 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #else # define tenviron environ # define tenviron2utfdstr(str, dsPtr) \ - Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr) + Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr) # define utf2tenvirondstr(str, dsPtr) \ - Tcl_UtfToExternalDString(NULL, str, -1, dsPtr) + Tcl_UtfToExternalDString(NULL, str, -1, dsPtr) # define techar char #endif + /* MODULE_SCOPE */ size_t TclEnvEpoch = 0; /* Epoch of the tcl environment * (if changed with tcl-env). */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 29d8a0c..334cfae 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -893,6 +893,7 @@ Tcl_SetExitProc( return prevExitProc; } + /* *---------------------------------------------------------------------- @@ -934,6 +935,7 @@ InvokeExitHandlers(void) firstExitPtr = NULL; Tcl_MutexUnlock(&exitMutex); } + /* *---------------------------------------------------------------------- diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 79bfb11..9996019 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -192,7 +192,7 @@ VarHashCreateVar( /* Verify the stack depth, only when no expansion is in progress */ #ifdef TCL_COMPILE_DEBUG -#define CHECK_STACK() \ +#define CHECK_STACK() \ do { \ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \ /*checkStack*/ !(starting || auxObjList)); \ @@ -202,53 +202,53 @@ VarHashCreateVar( #define CHECK_STACK() #endif -#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ - do { \ - TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \ - CHECK_STACK(); \ - if (nCleanup == 0) { \ - if (resultHandling != 0) { \ - if ((resultHandling) > 0) { \ - PUSH_OBJECT(objResultPtr); \ - } else { \ - *(++tosPtr) = objResultPtr; \ - } \ - } \ - pc += (pcAdjustment); \ - goto cleanup0; \ - } else if (resultHandling != 0) { \ - if ((resultHandling) > 0) { \ - Tcl_IncrRefCount(objResultPtr); \ - } \ - pc += (pcAdjustment); \ - switch (nCleanup) { \ - case 1: goto cleanup1_pushObjResultPtr; \ - case 2: goto cleanup2_pushObjResultPtr; \ - case 0: break; \ - } \ - } else { \ - pc += (pcAdjustment); \ - switch (nCleanup) { \ - case 1: goto cleanup1; \ - case 2: goto cleanup2; \ - case 0: break; \ - } \ - } \ +#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ + do { \ + TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \ + CHECK_STACK(); \ + if (nCleanup == 0) { \ + if (resultHandling != 0) { \ + if ((resultHandling) > 0) { \ + PUSH_OBJECT(objResultPtr); \ + } else { \ + *(++tosPtr) = objResultPtr; \ + } \ + } \ + pc += (pcAdjustment); \ + goto cleanup0; \ + } else if (resultHandling != 0) { \ + if ((resultHandling) > 0) { \ + Tcl_IncrRefCount(objResultPtr); \ + } \ + pc += (pcAdjustment); \ + switch (nCleanup) { \ + case 1: goto cleanup1_pushObjResultPtr; \ + case 2: goto cleanup2_pushObjResultPtr; \ + case 0: break; \ + } \ + } else { \ + pc += (pcAdjustment); \ + switch (nCleanup) { \ + case 1: goto cleanup1; \ + case 2: goto cleanup2; \ + case 0: break; \ + } \ + } \ } while (0) -#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ - CHECK_STACK(); \ - do { \ - pc += (pcAdjustment); \ - cleanup = (nCleanup); \ - if (resultHandling) { \ - if ((resultHandling) > 0) { \ - Tcl_IncrRefCount(objResultPtr); \ - } \ - goto cleanupV_pushObjResultPtr; \ - } else { \ - goto cleanupV; \ - } \ +#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ + CHECK_STACK(); \ + do { \ + pc += (pcAdjustment); \ + cleanup = (nCleanup); \ + if (resultHandling) { \ + if ((resultHandling) > 0) { \ + Tcl_IncrRefCount(objResultPtr); \ + } \ + goto cleanupV_pushObjResultPtr; \ + } else { \ + goto cleanupV; \ + } \ } while (0) #ifndef TCL_COMPILE_DEBUG @@ -258,16 +258,16 @@ VarHashCreateVar( switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ - break; \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ @@ -275,7 +275,7 @@ VarHashCreateVar( objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_F(0, (cleanup), 1); \ - break; \ + break; \ } \ } while (0) #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ @@ -284,16 +284,16 @@ VarHashCreateVar( switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ - break; \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ @@ -301,7 +301,7 @@ VarHashCreateVar( objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_V(0, (cleanup), 1); \ - break; \ + break; \ } \ } while (0) #else /* TCL_COMPILE_DEBUG */ @@ -377,14 +377,13 @@ VarHashCreateVar( #ifdef TCL_COMPILE_DEBUG # define TRACE(a) \ - while (traceInstructions) { \ - fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER \ - "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ - GetOpcodeName(pc)); \ - printf a; \ - break; \ + while (traceInstructions) { \ + fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ + CURR_DEPTH, \ + (pc - codePtr->codeStart), \ + GetOpcodeName(pc)); \ + printf a; \ + break; \ } # define TRACE_APPEND(a) \ while (traceInstructions) { \ @@ -394,16 +393,15 @@ VarHashCreateVar( # define TRACE_ERROR(interp) \ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); # define TRACE_WITH_OBJ(a, objPtr) \ - while (traceInstructions) { \ - fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER \ - "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ - GetOpcodeName(pc)); \ - printf a; \ - TclPrintObject(stdout, objPtr, 30); \ - fprintf(stdout, "\n"); \ - break; \ + while (traceInstructions) { \ + fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ + CURR_DEPTH, \ + (pc - codePtr->codeStart), \ + GetOpcodeName(pc)); \ + printf a; \ + TclPrintObject(stdout, objPtr, 30); \ + fprintf(stdout, "\n"); \ + break; \ } # define O2S(objPtr) \ (objPtr ? TclGetString(objPtr) : "") @@ -477,8 +475,7 @@ VarHashCreateVar( * usage in [incr]: do the first summand and the sum have != signs? */ -#define Overflowing(a,b,sum) \ - ((((a)^(sum)) < 0) && (((a)^(b)) >= 0)) +#define Overflowing(a,b,sum) ((((a)^(sum)) < 0) && (((a)^(b)) >= 0)) /* * Macro for checking whether the type is NaN, used when we're thinking about @@ -1027,6 +1024,7 @@ GrowEvaluationStack( } needed = growth + moveWords + WALLOCALIGN; + /* * Check if there is enough room in the next stack (if there is one, it * should be both empty and the last one!) @@ -1409,7 +1407,8 @@ CompileExprObj( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized + ByteCode *codePtr = NULL; + /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ /* @@ -1564,7 +1563,7 @@ TclCompileObj( int word) { Interp *iPtr = (Interp *) interp; - ByteCode *codePtr; /* Tcl Internal type of bytecode. */ + ByteCode *codePtr; /* Tcl Internal type of bytecode. */ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; /* @@ -2028,8 +2027,8 @@ TEBCresume( Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ const unsigned char *pc = (const unsigned char *)data[1]; - /* The current program counter. */ - unsigned char inst; /* The currently running instruction */ + /* The current program counter. */ + unsigned char inst; /* The currently running instruction */ /* * Transfer variables - needed only between opcodes, but not while @@ -2038,7 +2037,7 @@ TEBCresume( int cleanup = PTR2INT(data[2]); Tcl_Obj *objResultPtr; - int checkInterp = 0; /* Indicates when a check of interp readyness + int checkInterp = 0; /* Indicates when a check of interp readyness * is necessary. Set by CACHE_STACK_INFO() */ /* @@ -2092,7 +2091,7 @@ TEBCresume( goto cleanup0; } else { - /* resume from invocation */ + /* resume from invocation */ CACHE_STACK_INFO(); NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); @@ -2582,15 +2581,14 @@ TEBCresume( case INST_REVERSE: { Tcl_Obj **a, **b; - opnd = TclGetUInt4AtPtr(pc + 1); - a = tosPtr - (opnd - 1); + opnd = TclGetUInt4AtPtr(pc+1); + a = tosPtr-(opnd-1); b = tosPtr; - while (a < b) { + while (a OK\n", opnd)); NEXT_INST_F(5, 0, 0); @@ -2621,7 +2619,7 @@ TEBCresume( */ opnd = TclGetUInt4AtPtr(pc+1); - objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd - 1)); + objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); break; @@ -3184,7 +3182,7 @@ TEBCresume( O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr))); } #endif - varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, + varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (!varPtr) { TRACE_ERROR(interp); @@ -3775,7 +3773,7 @@ TEBCresume( if (varPtr) { if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) { DECACHE_STACK_INFO(); - TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, part2Ptr, + TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr, TCL_TRACE_READS, 0, -1); CACHE_STACK_INFO(); } @@ -4699,7 +4697,7 @@ TEBCresume( } /* - * End of TclOO support instructions. + * End of TclOO support instructions. * ----------------------------------------------------------------- * Start of INST_LIST and related instructions. */ @@ -4736,7 +4734,7 @@ TEBCresume( TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); /* special case for AbstractList */ - if (TclObjTypeHasProc(valuePtr, indexProc)) { + if (TclObjTypeHasProc(valuePtr,indexProc)) { DECACHE_STACK_INFO(); length = TclObjTypeLength(valuePtr); if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) { @@ -4827,7 +4825,7 @@ TEBCresume( */ /* special case for AbstractList */ - if (TclObjTypeHasProc(valuePtr, indexProc)) { + if (TclObjTypeHasProc(valuePtr,indexProc)) { length = TclObjTypeLength(valuePtr); /* Decode end-offset index values. */ @@ -4926,11 +4924,11 @@ TEBCresume( DECACHE_STACK_INFO(); if (TclObjTypeHasProc(valuePtr, setElementProc)) { objResultPtr = TclObjTypeSetElement(interp, - valuePtr, numIndices, - &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); + valuePtr, numIndices, + &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } else { objResultPtr = TclLsetFlat(interp, valuePtr, numIndices, - &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); + &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } if (!objResultPtr) { CACHE_STACK_INFO(); @@ -5076,60 +5074,60 @@ TEBCresume( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - s1 = TclGetStringFromObj(valuePtr, &s1len); - TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); - - if (TclObjTypeHasProc(value2Ptr, inOperProc) != NULL) { - int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match); - if (status != TCL_OK) { - TRACE_ERROR(interp); - goto gotError; - } - } else { - - if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { - TRACE_ERROR(interp); - goto gotError; - } - match = 0; - if (length > 0) { - Tcl_Size i = 0; - Tcl_Obj *o; - int isAbstractList = TclObjTypeHasProc(value2Ptr, indexProc) != NULL; - - /* - * An empty list doesn't match anything. - */ - - do { - if (isAbstractList) { - DECACHE_STACK_INFO(); - if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) { - CACHE_STACK_INFO(); - TRACE_ERROR(interp); - goto gotError; - } - CACHE_STACK_INFO(); - } else { - Tcl_ListObjIndex(NULL, value2Ptr, i, &o); - } - if (o != NULL) { - s2 = TclGetStringFromObj(o, &s2len); - } else { - s2 = ""; - s2len = 0; - } - if (s1len == s2len) { - match = (memcmp(s1, s2, s1len) == 0); - } - - /* Could be an ephemeral abstract obj */ - Tcl_BounceRefCount(o); - - i++; - } while (i < length && match == 0); - } - } + s1 = TclGetStringFromObj(valuePtr, &s1len); + TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); + + if (TclObjTypeHasProc(value2Ptr,inOperProc) != NULL) { + int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match); + if (status != TCL_OK) { + TRACE_ERROR(interp); + goto gotError; + } + } else { + + if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { + TRACE_ERROR(interp); + goto gotError; + } + match = 0; + if (length > 0) { + Tcl_Size i = 0; + Tcl_Obj *o; + int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL; + + /* + * An empty list doesn't match anything. + */ + + do { + if (isAbstractList) { + DECACHE_STACK_INFO(); + if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) { + CACHE_STACK_INFO(); + TRACE_ERROR(interp); + goto gotError; + } + CACHE_STACK_INFO(); + } else { + Tcl_ListObjIndex(NULL, value2Ptr, i, &o); + } + if (o != NULL) { + s2 = TclGetStringFromObj(o, &s2len); + } else { + s2 = ""; + s2len = 0; + } + if (s1len == s2len) { + match = (memcmp(s1, s2, s1len) == 0); + } + + /* Could be an ephemeral abstract obj */ + Tcl_BounceRefCount(o); + + i++; + } while (i < length && match == 0); + } + } if (*pc == INST_LIST_NOT_IN) { match = !match; @@ -5168,7 +5166,8 @@ TEBCresume( NEXT_INST_F(1, 1, 0); } - case INST_LREPLACE4: { + case INST_LREPLACE4: + { size_t numToDelete, numNewElems; int end_indicator; int haveSecondIndex, flags; @@ -5564,7 +5563,7 @@ TEBCresume( if ((*ustring1 == *ustring2) && /* Fix bug [69218ab7b]: restrict max compare length. */ ((end - ustring1) >= length2) && (length2 == 1 || - memcmp(ustring1, ustring2, + memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); @@ -6605,6 +6604,7 @@ TEBCresume( } CACHE_STACK_INFO(); + valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { if (valIndex >= listLen) { @@ -7383,7 +7383,7 @@ TEBCresume( goto gotError; } DECACHE_STACK_INFO(); - result = TclDictWithFinish(interp, varPtr, arrayPtr, varNamePtr, NULL, -1, + result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1, objc, objv, keysPtr); CACHE_STACK_INFO(); TclDecrRefCount(keysPtr); @@ -7426,15 +7426,16 @@ TEBCresume( * ----------------------------------------------------------------- */ - case INST_CLOCK_READ: { /* Read the wall clock */ - Tcl_WideInt wval; - Tcl_Time now; - switch (TclGetUInt1AtPtr(pc+1)) { - case 0: /* clicks */ + case INST_CLOCK_READ: + { /* Read the wall clock */ + Tcl_WideInt wval; + Tcl_Time now; + switch (TclGetUInt1AtPtr(pc+1)) { + case 0: /* clicks */ #ifdef TCL_WIDE_CLICKS - wval = TclpGetWideClicks(); + wval = TclpGetWideClicks(); #else - wval = (Tcl_WideInt)TclpGetClicks(); + wval = (Tcl_WideInt)TclpGetClicks(); #endif break; case 1: /* microseconds */ @@ -8656,17 +8657,17 @@ ExecuteExtendedBinaryMathOp( Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); err = mp_init(&bigResult); if (err == MP_OKAY) { - switch (opcode) { - case INST_ADD: + switch (opcode) { + case INST_ADD: err = mp_add(&big1, &big2, &bigResult); break; - case INST_SUB: + case INST_SUB: err = mp_sub(&big1, &big2, &bigResult); break; - case INST_MULT: + case INST_MULT: err = mp_mul(&big1, &big2, &bigResult); break; - case INST_DIV: + case INST_DIV: if (mp_iszero(&big2)) { mp_clear(&big1); mp_clear(&big2); @@ -8960,26 +8961,19 @@ TclCompareTwoNumbers( static void PrintByteCodeInfo( - ByteCode *codePtr) /* The bytecode whose summary is printed to + 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 %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" - TCL_Z_MODIFIER "u)\n", + fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n", codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); fprintf(stdout, " Source: "); TclPrintSource(stdout, codePtr->source, 60); - fprintf(stdout, - "\n Cmds %" TCL_Z_MODIFIER "u, src %" TCL_Z_MODIFIER - "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER - "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER - "u, code/src %.2f\n", + fprintf(stdout, "\n Cmds %" TCL_Z_MODIFIER "u, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n", codePtr->numCommands, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, codePtr->maxStackDepth, @@ -8990,11 +8984,8 @@ PrintByteCodeInfo( 0.0); #ifdef TCL_COMPILE_STATS - fprintf(stdout, - " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER - "u+inst %" TCL_Z_MODIFIER "u+litObj %" TCL_Z_MODIFIER - "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER - "u+cmdMap %" TCL_Z_MODIFIER "u\n", + fprintf(stdout, " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER + "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n", codePtr->structureSize, offsetof(ByteCode, localCachePtr), codePtr->numCodeBytes, @@ -9005,8 +8996,7 @@ PrintByteCodeInfo( #endif /* TCL_COMPILE_STATS */ if (procPtr != NULL) { fprintf(stdout, - " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %" - TCL_Z_MODIFIER "u, compiled locals %" TCL_Z_MODIFIER "u\n", + " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %" TCL_Z_MODIFIER "u\n", procPtr, procPtr->refCount, procPtr->numArgs, procPtr->numCompiledLocals); } @@ -9035,7 +9025,7 @@ PrintByteCodeInfo( #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( - ByteCode *codePtr, /* The bytecode whose summary is printed to + 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. */ @@ -9075,7 +9065,7 @@ ValidatePcAndStackTop( TclNewLiteralStringObj(message, "\n executing "); Tcl_IncrRefCount(message); Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL); - fprintf(stderr, "%s\n", TclGetString(message)); + fprintf(stderr,"%s\n", TclGetString(message)); Tcl_DecrRefCount(message); } else { fprintf(stderr, "\n"); @@ -9107,7 +9097,7 @@ static void IllegalExprOperandType( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ - const unsigned char *pc, /* Points to the instruction being executed + const unsigned char *pc, /* Points to the instruction being executed * when the illegal type was found. */ Tcl_Obj *opndPtr) /* Points to the operand holding the value * with the illegal type. */ @@ -9171,21 +9161,21 @@ TclGetSourceFromFrame( Tcl_Obj *const objv[]) { if (cfPtr == NULL) { - return Tcl_NewListObj(objc, objv); + return Tcl_NewListObj(objc, objv); } if (cfPtr->cmdObj == NULL) { - if (cfPtr->cmd == NULL) { + if (cfPtr->cmd == NULL) { ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; - cfPtr->cmd = GetSrcInfoForPc((unsigned char *) + cfPtr->cmd = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); - } + } if (cfPtr->cmd) { cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len); } else { cfPtr->cmdObj = Tcl_NewListObj(objc, objv); } - Tcl_IncrRefCount(cfPtr->cmdObj); + Tcl_IncrRefCount(cfPtr->cmdObj); } return cfPtr->cmdObj; } @@ -9557,7 +9547,7 @@ TclExprFloatError( int TclLog2( - int value) /* The integer for which to compute the log + int value) /* The integer for which to compute the log * base 2. */ { int n = value; @@ -9826,23 +9816,23 @@ EvalStatsCmd( currentHeaderBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Instructions %12.6g %8.1f%% %8.1f\n", statsPtr->currentInstBytes, - Percent(statsPtr->currentInstBytes, statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes), statsPtr->currentInstBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Literal ptr array %12.6g %8.1f%% %8.1f\n", statsPtr->currentLitBytes, - Percent(statsPtr->currentLitBytes, statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes), statsPtr->currentLitBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Exception table %12.6g %8.1f%% %8.1f\n", statsPtr->currentExceptBytes, - Percent(statsPtr->currentExceptBytes, statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes), statsPtr->currentExceptBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Auxiliary data %12.6g %8.1f%% %8.1f\n", statsPtr->currentAuxBytes, - Percent(statsPtr->currentAuxBytes, statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes), statsPtr->currentAuxBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Command map %12.6g %8.1f%% %8.1f\n", statsPtr->currentCmdMapBytes, - Percent(statsPtr->currentCmdMapBytes, statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes), statsPtr->currentCmdMapBytes / numCurrentByteCodes); /* diff --git a/generic/tclHash.c b/generic/tclHash.c index 89807e2..5be07cb 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -214,6 +214,7 @@ FindHashEntry( { return CreateHashEntry(tablePtr, key, NULL); } + /* *---------------------------------------------------------------------- @@ -300,7 +301,8 @@ CreateHashEntry( } /* if needle pointer equals content pointer or values equal */ if ((key == hPtr->key.string) - || compareKeysProc((void *) key, hPtr)) { + || compareKeysProc((void *) key, hPtr) + ) { if (newPtr) { *newPtr = 0; } diff --git a/generic/tclIO.c b/generic/tclIO.c index eec6062..78cda5c 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8711,8 +8711,9 @@ UpdateInterest( && (mask & TCL_WRITABLE) && GotFlag(statePtr, CHANNEL_NONBLOCKING) && bufPtr - && !IsBufferEmpty(bufPtr) - && !IsBufferFull(bufPtr)) { + && !IsBufferEmpty(bufPtr) + && !IsBufferFull(bufPtr) + ) { TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, @@ -8797,7 +8798,8 @@ ChannelTimerProc( static void DeleteTimerHandler( - ChannelState *statePtr) + ChannelState *statePtr +) { if (statePtr->timer != NULL) { Tcl_DeleteTimerHandler(statePtr->timer); @@ -8806,8 +8808,8 @@ DeleteTimerHandler( } static void CleanupTimerHandler( - ChannelState *statePtr) -{ + ChannelState *statePtr +){ TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); statePtr->timer = NULL; statePtr->timerChanPtr = NULL; @@ -10295,13 +10297,20 @@ Lossless( return inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF && outStatePtr->outputTranslation == TCL_TRANSLATE_LF - && ((inStatePtr->encoding == GetBinaryEncoding() - && outStatePtr->encoding == GetBinaryEncoding()) - || (toRead == -1 + && ( + ( + inStatePtr->encoding == GetBinaryEncoding() + && + outStatePtr->encoding == GetBinaryEncoding() + ) + || + ( + toRead == -1 && inStatePtr->encoding == outStatePtr->encoding && ENCODING_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 && ENCODING_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 - )); + ) + ); } /* diff --git a/generic/tclIO.h b/generic/tclIO.h index 8823e06..08fff44 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -191,8 +191,8 @@ typedef struct ChannelState { Tcl_Size bufSize; /* What size buffers to allocate? */ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ Channel *timerChanPtr; /* Needed in order to decrement the refCount of - * the right channel when the timer is - * deleted. */ + the right channel when the timer is + deleted. */ struct CopyState *csPtrR; /* State of background copy for which channel * is input, or NULL. */ struct CopyState *csPtrW; /* State of background copy for which channel diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index fc4ddb6..cb90059 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -606,6 +606,7 @@ Tcl_TellObjCmd( * them into the regular interpreter result. */ + code = TclChanCaughtErrorBypass(interp, chan); TclChannelRelease(chan); if (code) { diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 0118ce0..fe54f65 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -62,27 +62,27 @@ static void TimerRunWrite(void *clientData); */ static const Tcl_ChannelType tclRChannelType = { - "tclrchannel", /* Type name. */ + "tclrchannel", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Old close API */ - ReflectInput, /* Handle read request */ - ReflectOutput, /* Handle write request */ + NULL, /* Close channel, clean instance data */ + ReflectInput, /* Handle read request */ + ReflectOutput, /* Handle write request */ NULL, - ReflectSetOption, /* Set options. */ - ReflectGetOption, /* Get options. */ - ReflectWatch, /* Initialize notifier */ - NULL, /* Get OS handle from the channel. */ - ReflectClose, /* Close channel. Clean instance data */ - ReflectBlock, /* Set blocking/nonblocking. */ - NULL, /* Flush channel. */ - NULL, /* Handle events. */ - ReflectSeekWide, /* Move access point (64 bit). */ + ReflectSetOption, /* Set options. NULL'able */ + ReflectGetOption, /* Get options. NULL'able */ + ReflectWatch, /* Initialize notifier */ + NULL, /* Get OS handle from the channel. NULL'able */ + ReflectClose, /* No close2 support. NULL'able */ + ReflectBlock, /* Set blocking/nonblocking. NULL'able */ + NULL, /* Flush channel. Not used by core. NULL'able */ + NULL, /* Handle events. NULL'able */ + ReflectSeekWide, /* Move access point (64 bit). NULL'able */ #if TCL_THREADS - ReflectThread, /* thread action, tracking owner */ + ReflectThread, /* thread action, tracking owner */ #else - NULL, /* thread action */ + NULL, /* thread action */ #endif - ReflectTruncate /* Truncate. */ + ReflectTruncate /* Truncate. NULL'able */ }; /* @@ -96,10 +96,11 @@ typedef struct { * Tcl level part of the channel. NULL here * signals the channel is dead because the * interpreter/thread containing its Tcl - * command is gone. */ + * command is gone. + */ #if TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ - Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ + Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif Tcl_Obj *cmd; /* Callback command prefix */ Tcl_Obj *methods; /* Methods to append to command prefix */ @@ -112,12 +113,16 @@ typedef struct { int dead; /* Boolean signal that some operations * should no longer be attempted. */ - Tcl_TimerToken readTimer; /* A token for the timer that is scheduled in - * order to call Tcl_NotifyChannel when the - * channel is readable */ - Tcl_TimerToken writeTimer; /* A token for the timer that is scheduled in - * order to call Tcl_NotifyChannel when the - * channel is writable */ + Tcl_TimerToken readTimer; /* + A token for the timer that is scheduled in + order to call Tcl_NotifyChannel when the + channel is readable + */ + Tcl_TimerToken writeTimer; /* + A token for the timer that is scheduled in + order to call Tcl_NotifyChannel when the + channel is writable + */ /* * Note regarding the usage of timers. @@ -261,7 +266,7 @@ typedef struct { struct ForwardParamInput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* O: Where to store the read bytes */ - Tcl_Size toRead; /* I: #bytes to read, + Tcl_Size toRead; /* I: #bytes to read, * O: #bytes actually read */ }; struct ForwardParamOutput { @@ -508,7 +513,7 @@ TclChanCreateObjCmd( Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Channel chan; /* Token for the new channel */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - Tcl_Size listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 2ad6ecf0..c1e5c31 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -58,17 +58,18 @@ static int ReflectNotify(void *clientData, int mask); static const Tcl_ChannelType tclRTransformType = { "tclrtransform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel. */ - NULL, + NULL, /* Close channel, clean instance data. */ ReflectInput, /* Handle read request. */ ReflectOutput, /* Handle write request. */ - NULL, /* Move location of access point. */ + NULL, /* Move location of access point. */ ReflectSetOption, /* Set options. */ ReflectGetOption, /* Get options. */ ReflectWatch, /* Initialize notifier. */ ReflectHandle, /* Get OS handle from the channel. */ - ReflectClose, /* Close channel, clean instance data. */ + ReflectClose, /* No close2 support. NULL'able. */ ReflectBlock, /* Set blocking/nonblocking. */ - NULL, /* Flush channel. Not used by core. */ + NULL, /* Flush channel. Not used by core. + * NULL'able. */ ReflectNotify, /* Handle events. */ ReflectSeekWide, /* Move access point (64 bit). */ NULL, /* thread action */ @@ -510,7 +511,7 @@ TclChanPushObjCmd( Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Obj *rtId; /* Handle of the new transform (channel) */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - Tcl_Size listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ @@ -1104,6 +1105,7 @@ ReflectInput( goto stop; } + /* * The buffer is exhausted, but the caller wants even more. We now * have to go to the underlying channel, get more bytes and then @@ -1139,6 +1141,7 @@ ReflectInput( goto stop; } + readBytes = Tcl_ReadRaw(rtPtr->parent, (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead); if (readBytes < 0) { @@ -1489,7 +1492,7 @@ ReflectBlock( static int ReflectSetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ const char *newValue) /* The new value */ @@ -1531,7 +1534,7 @@ ReflectSetOption( static int ReflectGetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ Tcl_DString *dsPtr) /* String to place the result into */ @@ -1642,6 +1645,7 @@ ReflectNotify( /* * Helpers. ========================================================= */ + /* *---------------------------------------------------------------------- @@ -2071,8 +2075,7 @@ static ReflectedTransformMap * GetReflectedTransformMap( Tcl_Interp *interp) { - ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *) - Tcl_GetAssocData(interp, RTMKEY, NULL); + ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL); if (rtmPtr == NULL) { rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap)); @@ -2105,7 +2108,7 @@ GetReflectedTransformMap( static void DeleteReflectedTransformMap( - void *clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedTransformMap *rtmPtr; /* The map */ @@ -2240,8 +2243,7 @@ GetThreadReflectedTransformMap(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rtmPtr) { - tsdPtr->rtmPtr = (ReflectedTransformMap *) - Tcl_Alloc(sizeof(ReflectedTransformMap)); + tsdPtr->rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL); } @@ -2991,7 +2993,7 @@ static inline size_t ResultCopy( ResultBuffer *rPtr, /* The buffer to read from */ unsigned char *buf, /* The buffer to copy into */ - size_t toRead) /* Number of requested bytes */ + size_t toRead) /* Number of requested bytes */ { int copied; diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 81526fa..47fde36 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -18,7 +18,7 @@ typedef struct { int initialized; - Tcl_DString errorMsg; /* UTF-8 encoded error-message */ + Tcl_DString errorMsg; /* UTF-8 encoded error-message */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -75,8 +75,7 @@ TclSockGetPort( * Don't bother translating 'proto' to native. */ - if (Tcl_UtfToExternalDStringEx(interp, NULL, string, -1, 0, &ds, - NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, string, -1, 0, &ds, NULL) != TCL_OK) { Tcl_DStringFree(&ds); return TCL_ERROR; } @@ -189,8 +188,7 @@ TclCreateSocketAddress( int result; if (host != NULL) { - if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, - NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, NULL) != TCL_OK) { Tcl_DStringFree(&ds); return 0; } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index c3131cd..6067282 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -35,7 +35,7 @@ */ typedef struct FilesystemRecord { - void *clientData; /* Client-specific data for the filesystem + void *clientData; /* Client-specific data for the filesystem * (can be NULL) */ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */ struct FilesystemRecord *nextPtr; @@ -52,11 +52,13 @@ typedef struct FilesystemRecord { typedef struct { int initialized; size_t cwdPathEpoch; /* Compared with the global cwdPathEpoch to - * determine whether cwdPathPtr is stale. */ + * determine whether cwdPathPtr is stale. + */ size_t filesystemEpoch; Tcl_Obj *cwdPathPtr; /* A private copy of cwdPathPtr. Updated when * the value is accessed and cwdPathEpoch has - * changed. */ + * changed. + */ void *cwdClientData; FilesystemRecord *filesystemList; size_t claims; @@ -104,6 +106,7 @@ static Tcl_FSFileAttrsSetProc NativeFileAttrsSet; MODULE_SCOPE const char *const tclpFileAttrStrings[]; MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; + /* * These these functions are not static either because routines in the native * (win/unix) directories call them or they are actually implemented in those @@ -239,8 +242,7 @@ typedef struct { /* Obsolete */ int Tcl_Stat( - const char *path, /* Pathname of file to stat (in current system - * encoding). */ + const char *path, /* Pathname of file to stat (in current CP). */ struct stat *oldStyleBuf) /* Filled with results of stat call. */ { int ret; @@ -327,8 +329,8 @@ Tcl_Stat( /* Obsolete */ int Tcl_Access( - const char *path, /* Pathname of file to access (in current - * system encoding). */ + const char *path, /* Pathname of file to access (in current CP). + */ int mode) /* Permission setting. */ { int ret; @@ -843,7 +845,7 @@ TclResetFilesystem(void) int Tcl_FSRegister( - void *clientData, /* Client-specific data for this filesystem. */ + void *clientData, /* Client-specific data for this filesystem. */ const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */ { FilesystemRecord *newFilesystemPtr; @@ -1103,7 +1105,8 @@ FsAddMountsToGlobResult( Tcl_Obj *pathPtr, /* The directory that was searched. */ const char *pattern, /* Pattern to match mounts against. */ Tcl_GlobTypeData *types) /* Acceptable types. May be NULL. The - * directory flag is particularly significant. */ + * directory flag is particularly significant. + */ { Tcl_Size mLength, gLength, i; int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR)); @@ -1168,6 +1171,7 @@ FsAddMountsToGlobResult( } len++; /* account for '/' in the mElt [Bug 1602539] */ + mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len); Tcl_ListObjAppendElement(NULL, resultPtr, mElt); } @@ -1361,6 +1365,7 @@ TclFSNormalizeToUniquePath( Claim(); if (!isVfsPath) { + /* * Find and call the native filesystem handler first if there is one * because the root of Tcl's filesystem is always a native filesystem @@ -1688,7 +1693,7 @@ Tcl_FSEvalFileEx( * Tilde-substitution is performed on this * pathname. */ const char *encodingName) /* Either the name of an encoding or NULL to - * use the utf-8 encoding. */ + use the utf-8 encoding. */ { Tcl_Size length; int result = TCL_ERROR; @@ -2081,7 +2086,7 @@ Tcl_PosixError( int Tcl_FSStat( Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in - * current system encoding). */ + * current CP). */ Tcl_StatBuf *buf) /* A buffer to hold the results of the call to * stat. */ { @@ -2116,7 +2121,7 @@ Tcl_FSStat( int Tcl_FSLstat( Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in - * current system encoding). */ + current CP). */ Tcl_StatBuf *buf) /* Filled with results of that call to stat. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -2153,8 +2158,7 @@ Tcl_FSLstat( int Tcl_FSAccess( - Tcl_Obj *pathPtr, /* Pathname of file to access (in current - * system encoding). */ + Tcl_Obj *pathPtr, /* Pathname of file to access (in current CP). */ int mode) /* Permission setting. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -2191,11 +2195,12 @@ Tcl_FSOpenFileChannel( const char *modeString, /* A list of POSIX open modes or a string such * as "rw". */ int permissions) /* What modes to use if opening the file - * involves creating it. */ + involves creating it. */ { const Tcl_Filesystem *fsPtr; Tcl_Channel retVal = NULL; + if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { /* * Return the correct error message. @@ -3015,8 +3020,8 @@ Tcl_FSChdir( int Tcl_FSLoadFile( Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic - * shared object. */ + Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic shared object. + */ const char *sym1, const char *sym2, /* Names of two functions to find in the * dynamic shared object. */ @@ -3104,13 +3109,14 @@ skipUnlink( * * 1. The operating system is HPUX. * - * 2. If the environment variable TCL_TEMPLOAD_NO_UNLINK is present and - * set to true (an integer > 0) + * 2. If the environment variable TCL_TEMPLOAD_NO_UNLINK is present and + * set to true (an integer > 0) + * + * 3. TCL_TEMPLOAD_NO_UNLINK is not true (an integer > 0) and AUFS filesystem can be detected (using statfs, if available). * - * 3. TCL_TEMPLOAD_NO_UNLINK is not true (an integer > 0) and AUFS - * filesystem can be detected (using statfs, if available). */ + #ifdef hpux (void)shlibFile; return 1; @@ -3649,7 +3655,9 @@ Tcl_FSUnloadFile( Tcl_Obj * Tcl_FSLink( Tcl_Obj *pathPtr, /* Pathaname of file. */ - Tcl_Obj *toPtr, /* NULL or the pathname of a file to link to. */ + Tcl_Obj *toPtr, /* + * NULL or the pathname of a file to link to. + */ int linkAction) /* Action to perform. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -3898,8 +3906,7 @@ TclGetPathType( /* If not NULL, a place in which to store a * pointer to the filesystem for this pathname * if it is absolute. */ - Tcl_Size *driveNameLengthPtr, - /* If not NULL, a place in which to store the + Tcl_Size *driveNameLengthPtr, /* If not NULL, a place in which to store the * length of the volume name. */ Tcl_Obj **driveNameRef) /* If not NULL, for an absolute pathname, a * place to store a pointer to an object with a @@ -3953,9 +3960,9 @@ TclFSNonnativePathType( /* If not NULL, a place to store a pointer to * the filesystem for this pathname when it is * an absolute pathname. */ - Tcl_Size *driveNameLengthPtr, - /* If not NULL, a place to store the length of - * the volume name if the pathname is absolute. */ + Tcl_Size *driveNameLengthPtr,/* If not NULL, a place to store the length of + * the volume name if the pathname is absolute. + */ Tcl_Obj **driveNameRef) /* If not NULL, a place to store a pointer to * an object having its its refCount already * incremented, and contining the name of the @@ -4071,7 +4078,7 @@ TclFSNonnativePathType( int Tcl_FSRenameFile( Tcl_Obj *srcPathPtr, /* The pathname of a file or directory to be - * renamed. */ + renamed. */ Tcl_Obj *destPathPtr) /* The new pathname for the file. */ { int retVal = -1; diff --git a/generic/tclInt.h b/generic/tclInt.h index 768143c..c714cb8 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -257,7 +257,7 @@ typedef struct Namespace { * synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - void *clientData; /* An arbitrary value associated with this + void *clientData; /* An arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Procedure invoked when deleting the @@ -279,7 +279,7 @@ typedef struct Namespace { #else unsigned long nsId; #endif - Tcl_Interp *interp; /* The interpreter containing this + Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status * flags NS_DYING and NS_DEAD listed below. */ @@ -312,12 +312,12 @@ typedef struct Namespace { * registered using "namespace export". */ Tcl_Size maxExportPatterns; /* Number of export patterns for which space * is currently allocated. */ - Tcl_Size cmdRefEpoch; /* Incremented if a newly added command + Tcl_Size cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace * has already cached a Command* pointer; this * causes all its cached Command* pointers to * be invalidated. */ - Tcl_Size resolverEpoch; /* Incremented whenever (a) the name + Tcl_Size resolverEpoch; /* Incremented whenever (a) the name * resolution rules change for this namespace * or (b) a newly added command shadows a * command that is compiled to bytecodes. This @@ -424,8 +424,8 @@ struct NamespacePathEntry { * TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns. * TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces. * TCL_FIND_ONLY_NS - The name sought is a namespace name. - * TCL_FIND_IF_NOT_SIMPLE - Retrieve last namespace even if the rest of - * name is not simple name (contains ::). + * TCL_FIND_IF_NOT_SIMPLE - Retrieve last namespace even if the rest of + * name is not simple name (contains ::). */ #define TCL_CREATE_NS_IF_UNKNOWN 0x800 @@ -447,7 +447,7 @@ typedef struct EnsembleConfig { * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ - Tcl_Size epoch; /* The epoch at which this ensemble's table of + Tcl_Size epoch; /* The epoch at which this ensemble's table of * exported commands is valid. */ char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all * consistent points, this will have the same @@ -504,7 +504,7 @@ typedef struct EnsembleConfig { * core, presumably because the ensemble * itself has been updated. */ Tcl_Obj *parameterList; /* List of ensemble parameter names. */ - Tcl_Size numParameters; /* Cached number of parameters. This is either + Tcl_Size numParameters; /* Cached number of parameters. This is either * 0 (if the parameterList field is NULL) or * the length of the list in the parameterList * field. */ @@ -534,7 +534,7 @@ typedef struct EnsembleConfig { typedef struct VarTrace { Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by * flags are performed on variable. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_READS, TCL_TRACE_WRITES, @@ -553,7 +553,7 @@ typedef struct CommandTrace { Tcl_CommandTraceProc *traceProc; /* Procedure to call when operations given by * flags are performed on command. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ @@ -834,10 +834,10 @@ typedef struct VarInHash { #define TclVarFindHiddenArray(varPtr,arrayPtr) \ do { \ - if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ - (TclVarParentArray(varPtr) != NULL)) { \ - arrayPtr = TclVarParentArray(varPtr); \ - } \ + if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ + (TclVarParentArray(varPtr) != NULL)) { \ + arrayPtr = TclVarParentArray(varPtr); \ + } \ } while(0) #define TclIsVarScalar(varPtr) \ @@ -903,13 +903,13 @@ typedef struct VarInHash { #define TclIsVarTricky(varPtr,trickyFlags) \ ( ((varPtr)->flags & (VAR_ARRAY|VAR_LINK|trickyFlags)) \ - || (TclIsVarInHash(varPtr) \ - && (TclVarParentArray(varPtr) != NULL) \ - && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) + || (TclIsVarInHash(varPtr) \ + && (TclVarParentArray(varPtr) != NULL) \ + && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) #define TclIsVarDirectReadable(varPtr) \ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ)) \ - && (varPtr)->value.objPtr) + && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT)) @@ -919,7 +919,7 @@ typedef struct VarInHash { #define TclIsVarDirectModifyable(varPtr) \ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT)) \ - && (varPtr)->value.objPtr) + && (varPtr)->value.objPtr) #define TclIsVarDirectReadable2(varPtr, arrayPtr) \ (TclIsVarDirectReadable(varPtr) &&\ @@ -973,9 +973,9 @@ typedef struct CompiledLocal { /* Next compiler-recognized local variable for * this procedure, or NULL if this is the last * local. */ - Tcl_Size nameLength; /* The number of bytes in local variable's name. + Tcl_Size nameLength; /* The number of bytes in local variable's name. * Among others used to speed up var lookups. */ - Tcl_Size frameIndex; /* Index in the array of compiler-assigned + Tcl_Size frameIndex; /* Index in the array of compiler-assigned * variables in the procedure call frame. */ #if TCL_MAJOR_VERSION < 9 int flags; @@ -996,7 +996,7 @@ typedef struct CompiledLocal { * although only VAR_ARGUMENT, VAR_TEMPORARY, * and VAR_RESOLVED make sense. */ #endif - char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If + char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If * the name is NULL, this will just be '\0'. * The actual size of this field will be large * enough to hold the name. MUST BE THE LAST @@ -1058,7 +1058,7 @@ typedef struct Trace { #else Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */ #endif - void *clientData; /* Arbitrary value to pass to proc. */ + void *clientData; /* Arbitrary value to pass to proc. */ struct Trace *nextPtr; /* Next in list of traces for this interp. */ int flags; /* Flags governing the trace - see * Tcl_CreateObjTrace for details. */ @@ -1108,17 +1108,18 @@ typedef struct ActiveInterpTrace { ((objPtr)->typePtr)->proc : NULL) MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *); + /* * Abstract List * - * This structure provides the functions used in List operations to emulate a - * List for AbstractList types. + * This structure provides the functions used in List operations to emulate a + * List for AbstractList types. */ + static inline Tcl_Size -TclObjTypeLength( - Tcl_Obj *objPtr) +TclObjTypeLength(Tcl_Obj *objPtr) { Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc); return proc(objPtr); @@ -1187,17 +1188,15 @@ TclObjTypeReplace( return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs); } static inline int -TclObjTypeInOperator( - Tcl_Interp *interp, - Tcl_Obj *valueObj, - Tcl_Obj *listObj, - int *boolResult) +TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj, + struct Tcl_Obj *listObj, int *boolResult) { Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc); return proc(interp, valueObj, listObj, boolResult); } #endif /* TCL_MAJOR_VERSION > 8 */ + /* * The structure below defines an entry in the assocData hash table which is * associated with an interpreter. The entry contains a pointer to a function @@ -1207,7 +1206,7 @@ TclObjTypeInOperator( typedef struct AssocData { Tcl_InterpDeleteProc *proc; /* Proc to call when deleting. */ - void *clientData; /* Value to pass to proc. */ + void *clientData; /* Value to pass to proc. */ } AssocData; /* @@ -1251,10 +1250,11 @@ typedef struct CallFrame { * If FRAME_IS_PROC is set, the frame was * pushed to execute a Tcl procedure and may * have local vars. */ - Tcl_Size objc; /* This and objv below describe the arguments + Tcl_Size objc; /* This and objv below describe the arguments * for this procedure call. */ Tcl_Obj *const *objv; /* Array of argument objects. */ - struct CallFrame *callerPtr;/* Value of interp->framePtr when this + struct CallFrame *callerPtr; + /* Value of interp->framePtr when this * procedure was invoked (i.e. next higher in * stack of all active procedures). */ struct CallFrame *callerVarPtr; @@ -1264,7 +1264,7 @@ typedef struct CallFrame { * callerPtr unless an "uplevel" command or * something equivalent was active in the * caller). */ - Tcl_Size level; /* Level of this procedure, for "uplevel" + Tcl_Size level; /* Level of this procedure, for "uplevel" * purposes (i.e. corresponds to nesting of * callerVarPtr's, not callerPtr's). 1 for * outermost procedure, 0 for top-level. */ @@ -1284,7 +1284,7 @@ typedef struct CallFrame { * recognized by the compiler. The compiler * emits code that refers to these variables * using an index into this array. */ - void *clientData; /* Pointer to some context that is used by + void *clientData; /* Pointer to some context that is used by * object systems. The meaning of the contents * of this field is defined by the code that * sets it, and it should only ever be set by @@ -1294,7 +1294,8 @@ typedef struct CallFrame { * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; - Tcl_Obj *tailcallPtr; /* NULL if no tailcall is scheduled */ + Tcl_Obj *tailcallPtr; + /* NULL if no tailcall is scheduled */ } CallFrame; #define FRAME_IS_PROC 0x1 @@ -1383,7 +1384,7 @@ typedef struct CmdFrame { } data; Tcl_Obj *cmdObj; const char *cmd; /* The executed command, if possible... */ - Tcl_Size len; /* ... and its length. */ + Tcl_Size len; /* ... and its length. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have * ben pushed on the lineLABCPtr stack by @@ -1393,16 +1394,16 @@ typedef struct CmdFrame { typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ - Tcl_Size word; /* Index of the word in the command. */ + Tcl_Size word; /* Index of the word in the command. */ Tcl_Size refCount; /* Number of times the word is on the * stack. */ } CFWord; typedef struct CFWordBC { CmdFrame *framePtr; /* CmdFrame to access. */ - Tcl_Size pc; /* Instruction pointer of a command in + Tcl_Size pc; /* Instruction pointer of a command in * ExtCmdLoc.loc[.] */ - Tcl_Size word; /* Index of word in + Tcl_Size word; /* Index of word in * ExtCmdLoc.loc[cmd]->line[.] */ struct CFWordBC *prevPtr; /* Previous entry in stack for same Tcl_Obj. */ struct CFWordBC *nextPtr; /* Next entry for same command call. See @@ -1431,7 +1432,7 @@ typedef struct CFWordBC { #define CLL_END (-1) typedef struct ContLineLoc { - Tcl_Size num; /* Number of entries in loc, not counting the + Tcl_Size num; /* Number of entries in loc, not counting the * final -1 marker entry. */ Tcl_Size loc[TCLFLEXARRAY];/* Table of locations, as character offsets. * The table is allocated as part of the @@ -1474,14 +1475,14 @@ typedef struct ContLineLoc { typedef Tcl_Obj * (GetFrameInfoValueProc)(void *clientData); typedef struct { const char *name; /* Name of this field. */ - GetFrameInfoValueProc *proc;/* Function to generate a Tcl_Obj* from the + GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the * clientData, or just use the clientData * directly (after casting) if NULL. */ - void *clientData; /* Context for above function, or Tcl_Obj* if + void *clientData; /* Context for above function, or Tcl_Obj* if * proc field is NULL. */ } ExtraFrameInfoField; typedef struct { - Tcl_Size length; /* Length of array. */ + Tcl_Size length; /* Length of array. */ ExtraFrameInfoField fields[2]; /* Really as long as necessary, but this is * long enough for nearly anything. */ @@ -1604,22 +1605,22 @@ typedef struct CoroutineData { * the coroutine, which might be the * interpreter global environment or another * coroutine. */ - CorContext caller; /* Caller's saved execution context. */ - CorContext running; /* This coroutine's saved execution context. */ - Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ + CorContext caller; + CorContext running; + Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ void *stackLevel; - Tcl_Size auxNumLevels; /* While the coroutine is running the + Tcl_Size auxNumLevels; /* While the coroutine is running the * numLevels of the create/resume command is * stored here; for suspended coroutines it * holds the nesting numLevels at yield. */ - Tcl_Size nargs; /* Number of args required for resuming this - * coroutine; COROUTINE_ARGUMENTS_SINGLE_OPTIONAL - * means "0 or 1" (default), - * COROUTINE_ARGUMENTS_ARBITRARY means "any" */ + Tcl_Size nargs; /* Number of args required for resuming this + * coroutine; COROUTINE_ARGUMENTS_SINGLE_OPTIONAL means "0 or 1" + * (default), COROUTINE_ARGUMENTS_ARBITRARY means "any" */ Tcl_Obj *yieldPtr; /* The command to yield to. Stored here in * order to reset splice point in * TclNRCoroutineActivateCallback if the - * coroutine is busy. */ + * coroutine is busy. + */ } CoroutineData; typedef struct ExecEnv { @@ -1676,11 +1677,11 @@ typedef struct LiteralTable { LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables to avoid * mallocs and frees. */ - TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at + TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at * **buckets. */ - TCL_HASH_TYPE numEntries; /* Total number of entries present in + TCL_HASH_TYPE numEntries; /* Total number of entries present in * table. */ - TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be + TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ TCL_HASH_TYPE mask; /* Mask value used in hashing function. */ } LiteralTable; @@ -1693,11 +1694,10 @@ typedef struct LiteralTable { #ifdef TCL_COMPILE_STATS typedef struct ByteCodeStats { - size_t numExecutions; /* Number of ByteCodes executed. */ + size_t numExecutions; /* Number of ByteCodes executed. */ size_t numCompilations; /* Number of ByteCodes created. */ size_t numByteCodesFreed; /* Number of ByteCodes destroyed. */ - size_t instructionCount[256]; - /* Number of times each instruction was + size_t instructionCount[256]; /* Number of times each instruction was * executed. */ double totalSrcBytes; /* Total source bytes ever compiled. */ @@ -1705,7 +1705,7 @@ typedef struct ByteCodeStats { double currentSrcBytes; /* Src bytes for all current ByteCodes. */ double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */ - size_t srcCount[32]; /* Source size distribution: # of srcs of + size_t srcCount[32]; /* Source size distribution: # of srcs of * size [2**(n-1)..2**n), n in [0..32). */ size_t byteCodeCount[32]; /* ByteCode size distribution. */ size_t lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ @@ -1735,7 +1735,7 @@ typedef struct { Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */ CompileProc *compileProc; /* The compiler for the subcommand. */ Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */ - void *clientData; /* Any clientData to give the command. */ + void *clientData; /* Any clientData to give the command. */ int unsafe; /* Whether this command is to be hidden by * default in a safe interpreter. */ } EnsembleImplMap; @@ -1814,11 +1814,11 @@ typedef struct Command { Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */ void *objClientData; /* Arbitrary value passed to object proc. */ Tcl_CmdProc *proc; /* String-based command procedure. */ - void *clientData; /* Arbitrary value passed to string proc. */ + void *clientData; /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Procedure invoked when deleting command to, * e.g., free all client data. */ - void *deleteData; /* Arbitrary value passed to deleteProc. */ + void *deleteData; /* Arbitrary value passed to deleteProc. */ int flags; /* Miscellaneous bits of information about * command. See below for definitions. */ ImportRef *importRefPtr; /* List of each imported Command created in @@ -1857,13 +1857,14 @@ typedef struct Command { * (these last two flags are defined in tcl.h) */ -#define CMD_DYING 0x01 -#define CMD_TRACE_ACTIVE 0x02 -#define CMD_HAS_EXEC_TRACES 0x04 -#define CMD_COMPILES_EXPANDED 0x08 -#define CMD_REDEF_IN_PROGRESS 0x10 -#define CMD_VIA_RESOLVER 0x20 -#define CMD_DEAD 0x40 +#define CMD_DYING 0x01 +#define CMD_TRACE_ACTIVE 0x02 +#define CMD_HAS_EXEC_TRACES 0x04 +#define CMD_COMPILES_EXPANDED 0x08 +#define CMD_REDEF_IN_PROGRESS 0x10 +#define CMD_VIA_RESOLVER 0x20 +#define CMD_DEAD 0x40 + /* *---------------------------------------------------------------- @@ -1963,7 +1964,8 @@ typedef struct Interp { * enabled extensions check for a NULL pointer value * and for a TCL_STUBS_MAGIC value to verify they * are not [load]ing into one of those pre-stubs - * interps. */ + * interps. + */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ @@ -1973,7 +1975,7 @@ typedef struct Interp { /* Hash table used by tclBasic.c to keep track * of hidden commands on a per-interp * basis. */ - void *interpInfo; /* Information used by tclInterp.c to keep + void *interpInfo; /* Information used by tclInterp.c to keep * track of parent/child interps on a * per-interp basis. */ #if TCL_MAJOR_VERSION > 8 @@ -2052,7 +2054,7 @@ typedef struct Interp { * compiled by the interpreter. Indexed by the * string representations of literals. Used to * avoid creating duplicate objects. */ - Tcl_Size compileEpoch; /* Holds the current "compilation epoch" for + Tcl_Size compileEpoch; /* Holds the current "compilation epoch" for * this interpreter. This is incremented to * invalidate existing ByteCodes when, e.g., a * command with a compile procedure is @@ -2062,7 +2064,8 @@ typedef struct Interp { * NULL. Set by ObjInterpProc in tclProc.c and * used by tclCompile.c to process local * variables appropriately. */ - ResolverScheme *resolverPtr;/* Linked list of name resolution schemes + ResolverScheme *resolverPtr; + /* Linked list of name resolution schemes * added to this interpreter. Schemes are * added and removed by calling * Tcl_AddInterpResolvers and @@ -2097,8 +2100,8 @@ typedef struct Interp { ActiveInterpTrace *activeInterpTracePtr; /* First in list of active traces for interp, * or NULL if no active traces. */ - Tcl_Size tracesForbiddingInline; - /* Count of traces (in the list headed by + + Tcl_Size tracesForbiddingInline; /* Count of traces (in the list headed by * tracePtr) that forbid inline bytecode * compilation. */ @@ -2128,7 +2131,7 @@ typedef struct Interp { * as flag values the same as the 'active' * field. */ - Tcl_Size cmdCount; /* Limit for how many commands to execute in + Tcl_Size cmdCount; /* Limit for how many commands to execute in * the interpreter. */ LimitHandler *cmdHandlers; /* Handlers to execute when the limit is @@ -2164,9 +2167,9 @@ typedef struct Interp { * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not * processing an ensemble. */ - Tcl_Size numRemovedObjs;/* How many arguments have been stripped off + Tcl_Size numRemovedObjs; /* How many arguments have been stripped off * because of ensemble processing. */ - Tcl_Size numInsertedObjs;/* How many of the current arguments were + Tcl_Size numInsertedObjs; /* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; @@ -2205,7 +2208,7 @@ typedef struct Interp { * Proc structure for a procedure. The values * are "struct ExtCmdLoc*". (See * tclCompile.h) */ - Tcl_HashTable *lineLABCPtr; /* Tcl_Obj* (by exact pointer) -> CFWordBC* */ + Tcl_HashTable *lineLABCPtr; Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a * command on the execution stack the index of * the argument in the command, and the @@ -2226,7 +2229,8 @@ typedef struct Interp { * used by function ...() in the same file. * It does for the eval/direct path of script * execution what CompileEnv.clLoc does for - * the bytecode compiler. */ + * the bytecode compiler. + */ /* * TIP #268. The currently active selection mode, i.e. the package require * preferences. @@ -2298,7 +2302,7 @@ typedef struct Interp { Tcl_Obj *callLiteral; /* "CALL" literal for [info errorstack] */ Tcl_Obj *innerLiteral; /* "INNER" literal for [info errorstack] */ Tcl_Obj *innerContext; /* cached list for fast reallocation */ - int resetErrorStack; /* controls cleaning up of ::errorStack */ + int resetErrorStack; /* controls cleaning up of ::errorStack */ #ifdef TCL_COMPILE_STATS /* @@ -2325,10 +2329,10 @@ typedef struct Interp { #define TclCanceled(iPtr) \ (((iPtr)->flags & CANCELED) || ((iPtr)->flags & TCL_CANCEL_UNWIND)) -#define TclSetCancelFlags(iPtr, cancelFlags) \ - (iPtr)->flags |= CANCELED; \ - if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ - (iPtr)->flags |= TCL_CANCEL_UNWIND; \ +#define TclSetCancelFlags(iPtr, cancelFlags) \ + (iPtr)->flags |= CANCELED; \ + if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ + (iPtr)->flags |= TCL_CANCEL_UNWIND; \ } #define TclUnsetCancelFlags(iPtr) \ @@ -2490,8 +2494,7 @@ struct TclMaxAlignment { */ #define TclOOM(ptr, size) \ - ((size) && ((ptr) || (Tcl_Panic( \ - "unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)), 1))) + ((size) && ((ptr)||(Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)),1))) /* * The following enum values are used to specify the runtime platform setting @@ -2561,38 +2564,36 @@ typedef enum TclEolTranslation { * */ typedef struct ListStore { - Tcl_Size firstUsed; /* Index of first slot in use within slots[] */ - Tcl_Size numUsed; /* Number of slots in use (starting firstUsed) */ - Tcl_Size numAllocated; /* Total number of slots[] array slots. */ - size_t refCount; /* Number of references to this instance. */ - int flags; /* LISTSTORE_* flags */ - Tcl_Obj *slots[TCLFLEXARRAY]; - /* Variable size array. Grown as needed */ + Tcl_Size firstUsed; /* Index of first slot in use within slots[] */ + Tcl_Size numUsed; /* Number of slots in use (starting firstUsed) */ + Tcl_Size numAllocated; /* Total number of slots[] array slots. */ + size_t refCount; /* Number of references to this instance */ + int flags; /* LISTSTORE_* flags */ + Tcl_Obj *slots[TCLFLEXARRAY]; /* Variable size array. Grown as needed */ } ListStore; #define LISTSTORE_CANONICAL 0x1 /* All Tcl_Obj's referencing this - * store have their string representation - * derived from the list representation */ + store have their string representation + derived from the list representation */ /* Max number of elements that can be contained in a list */ -#define LIST_MAX \ - ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \ - / sizeof(Tcl_Obj *))) +#define LIST_MAX \ + ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \ + / sizeof(Tcl_Obj *))) /* Memory size needed for a ListStore to hold numSlots_ elements */ #define LIST_SIZE(numSlots_) \ - ((Tcl_Size)(offsetof(ListStore, slots) \ - + ((numSlots_) * sizeof(Tcl_Obj *)))) + ((Tcl_Size)(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *)))) /* * ListSpan -- * See comments above for ListStore */ typedef struct ListSpan { - Tcl_Size spanStart; /* Starting index of the span. */ - Tcl_Size spanLength; /* Number of elements in the span. */ - size_t refCount; /* Count of references to this span record. */ + Tcl_Size spanStart; /* Starting index of the span */ + Tcl_Size spanLength; /* Number of elements in the span */ + size_t refCount; /* Count of references to this span record */ } ListSpan; -#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */ +#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */ #define LIST_SPAN_THRESHOLD 101 #endif @@ -2601,11 +2602,9 @@ typedef struct ListSpan { * See comments above for ListStore */ typedef struct ListRep { - ListStore *storePtr; /* element array shared amongst different - * lists */ - ListSpan *spanPtr; /* If not NULL, the span holds the range of - * slots within *storePtr that contain this - * list elements. */ + ListStore *storePtr;/* element array shared amongst different lists */ + ListSpan *spanPtr; /* If not NULL, the span holds the range of slots + within *storePtr that contain this list elements. */ } ListRep; /* @@ -2621,16 +2620,14 @@ typedef struct ListRep { */ /* Returns the starting slot for this listRep in the contained ListStore */ -#define ListRepStart(listRepPtr_) \ - ((listRepPtr_)->spanPtr \ - ? (listRepPtr_)->spanPtr->spanStart \ - : (listRepPtr_)->storePtr->firstUsed) +#define ListRepStart(listRepPtr_) \ + ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanStart \ + : (listRepPtr_)->storePtr->firstUsed) /* Returns the number of elements in this listRep */ -#define ListRepLength(listRepPtr_) \ - ((listRepPtr_)->spanPtr \ - ? (listRepPtr_)->spanPtr->spanLength \ - : (listRepPtr_)->storePtr->numUsed) +#define ListRepLength(listRepPtr_) \ + ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanLength \ + : (listRepPtr_)->storePtr->numUsed) /* Returns a pointer to the first slot containing this ListRep elements */ #define ListRepElementsBase(listRepPtr_) \ @@ -2638,7 +2635,7 @@ typedef struct ListRep { /* Stores the number of elements and base address of the element array */ #define ListRepElements(listRepPtr_, objc_, objv_) \ - (((objv_) = ListRepElementsBase(listRepPtr_)), \ + (((objv_) = ListRepElementsBase(listRepPtr_)), \ ((objc_) = ListRepLength(listRepPtr_))) /* Returns 1/0 whether the ListRep's ListStore is shared. */ @@ -2653,36 +2650,34 @@ typedef struct ListRep { ((ListSpan *)((listObj_)->internalRep.twoPtrValue.ptr2)) /* Returns the ListRep internal representaton in a Tcl_Obj */ -#define ListObjGetRep(listObj_, listRepPtr_) \ - do { \ - (listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \ - (listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_); \ +#define ListObjGetRep(listObj_, listRepPtr_) \ + do { \ + (listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \ + (listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_); \ } while (0) /* Returns the length of the list */ -#define ListObjLength(listObj_, len_) \ - ((len_) = ListObjSpanPtr(listObj_) \ - ? ListObjSpanPtr(listObj_)->spanLength \ - : ListObjStorePtr(listObj_)->numUsed) +#define ListObjLength(listObj_, len_) \ + ((len_) = ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanLength \ + : ListObjStorePtr(listObj_)->numUsed) /* Returns the starting slot index of this list's elements in the ListStore */ -#define ListObjStart(listObj_) \ - (ListObjSpanPtr(listObj_) \ - ? ListObjSpanPtr(listObj_)->spanStart \ - : ListObjStorePtr(listObj_)->firstUsed) +#define ListObjStart(listObj_) \ + (ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanStart \ + : ListObjStorePtr(listObj_)->firstUsed) /* Stores the element count and base address of this list's elements */ #define ListObjGetElements(listObj_, objc_, objv_) \ (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \ (ListObjLength(listObj_, (objc_)))) + /* * Returns 1/0 whether the internal representation (not the Tcl_Obj itself) * is shared. Note by intent this only checks for sharing of ListStore, * not spans. */ -#define ListObjRepIsShared(listObj_) \ - (ListObjStorePtr(listObj_)->refCount > 1) +#define ListObjRepIsShared(listObj_) (ListObjStorePtr(listObj_)->refCount > 1) /* * Certain commands like concat are optimized if an existing string @@ -2699,10 +2694,10 @@ typedef struct ListRep { * and never from strings (see SetListFromAny) and thus their string * representation will always be canonical. */ -#define ListObjIsCanonical(listObj_) \ - (((listObj_)->bytes == NULL) \ - || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \ - || ListObjSpanPtr(listObj_) != NULL) +#define ListObjIsCanonical(listObj_) \ + (((listObj_)->bytes == NULL) \ + || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \ + || ListObjSpanPtr(listObj_) != NULL) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element @@ -2710,27 +2705,25 @@ typedef struct ListRep { * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be * converted to a list. */ -#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ - TCL_OK) \ - : Tcl_ListObjGetElements( \ - (interp_), (listObj_), (objcPtr_), (objvPtr_))) +#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ + TCL_OK) \ + : Tcl_ListObjGetElements( \ + (interp_), (listObj_), (objcPtr_), (objvPtr_))) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element * count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the * Tcl_Obj cannot be converted to a list. */ -#define TclListObjLength(interp_, listObj_, lenPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ - : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) +#define TclListObjLength(interp_, listObj_, lenPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ + : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) #define TclListObjIsCanonical(listObj_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ListObjIsCanonical((listObj_)) \ - : 0) + ((TclHasInternalRep((listObj_), &tclListType)) ? ListObjIsCanonical((listObj_)) : 0) /* * Modes for collecting (or not) in the implementations of TclNRForeachCmd, @@ -2750,45 +2743,44 @@ typedef struct ListRep { #if TCL_MAJOR_VERSION > 8 #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ - || TclHasInternalRep((objPtr), &tclBooleanType)) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ + || TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #else #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ + ((TclHasInternalRep((objPtr), &tclIntType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ - : (TclHasInternalRep((objPtr), &tclBooleanType)) \ + : (TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #endif #ifdef TCL_WIDE_INT_IS_LONG #define TclGetLongFromObj(interp, objPtr, longPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ - ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) + ((TclHasInternalRep((objPtr), &tclIntType)) \ + ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #else #define TclGetLongFromObj(interp, objPtr, longPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \ - ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) + ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #endif #define TclGetIntFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ - ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) + ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ - (((TclHasInternalRep((objPtr), &tclIntType)) \ - && ((objPtr)->internalRep.wideValue >= 0) \ - && ((objPtr)->internalRep.wideValue <= endValue)) \ - ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) + (((TclHasInternalRep((objPtr), &tclIntType)) && ((objPtr)->internalRep.wideValue >= 0) \ + && ((objPtr)->internalRep.wideValue <= endValue)) \ + ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* * Macro used to save a function call for common uses of @@ -2799,9 +2791,10 @@ typedef struct ListRep { */ #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ - ? (*(wideIntPtr) = ((objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) + ((TclHasInternalRep((objPtr), &tclIntType)) \ + ? (*(wideIntPtr) = \ + ((objPtr)->internalRep.wideValue), TCL_OK) : \ + Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) /* * Flag values for TclTraceDictPath(). @@ -2846,8 +2839,7 @@ typedef struct ListRep { #define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2) typedef void *(TclFSGetCwdProc2)(void *clientData); typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr, - Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, - int flags); + Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); /* * The following types are used for getting and storing platform-specific file @@ -2898,14 +2890,13 @@ typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp, *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, - TCL_HASH_TYPE *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr); #ifdef _WIN32 # define TCLFSENCODING tclUtf8Encoding /* On Windows, all Unicode (except surrogates) are valid */ #else -# define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */ +# define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */ #endif /* @@ -2917,7 +2908,7 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, */ typedef struct ProcessGlobalValue { - Tcl_Size epoch; /* Epoch counter to detect changes in the + Tcl_Size epoch; /* Epoch counter to detect changes in the * global value. */ TCL_HASH_TYPE numBytes; /* Length of the global string. */ char *value; /* The global string value. */ @@ -2939,25 +2930,26 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------------- */ -#define TCL_PARSE_DECIMAL_ONLY 1 +#define TCL_PARSE_DECIMAL_ONLY 1 /* Leading zero doesn't denote octal or * hex. */ -#define TCL_PARSE_OCTAL_ONLY 2 +#define TCL_PARSE_OCTAL_ONLY 2 /* Parse octal even without prefix. */ #define TCL_PARSE_HEXADECIMAL_ONLY 4 /* Parse hexadecimal even without prefix. */ -#define TCL_PARSE_INTEGER_ONLY 8 +#define TCL_PARSE_INTEGER_ONLY 8 /* Disable floating point parsing. */ -#define TCL_PARSE_SCAN_PREFIXES 16 +#define TCL_PARSE_SCAN_PREFIXES 16 /* Use [scan] rules dealing with 0? * prefixes. */ -#define TCL_PARSE_NO_WHITESPACE 32 +#define TCL_PARSE_NO_WHITESPACE 32 /* Reject leading/trailing whitespace. */ #define TCL_PARSE_BINARY_ONLY 64 /* Parse binary even without prefix. */ #define TCL_PARSE_NO_UNDERSCORE 128 /* Reject underscore digit separator */ + /* *---------------------------------------------------------------------- * Internal convenience macros for manipulating encoding flags. See @@ -2966,12 +2958,11 @@ typedef struct ProcessGlobalValue { */ #define ENCODING_PROFILE_MASK 0xFF000000 -#define ENCODING_PROFILE_GET(flags_) \ - ((flags_) & ENCODING_PROFILE_MASK) -#define ENCODING_PROFILE_SET(flags_, profile_) \ - do { \ - (flags_) &= ~ENCODING_PROFILE_MASK; \ - (flags_) |= ((profile_) & ENCODING_PROFILE_MASK); \ +#define ENCODING_PROFILE_GET(flags_) ((flags_) & ENCODING_PROFILE_MASK) +#define ENCODING_PROFILE_SET(flags_, profile_) \ + do { \ + (flags_) &= ~ENCODING_PROFILE_MASK; \ + (flags_) |= ((profile_) & ENCODING_PROFILE_MASK);\ } while (0) /* @@ -2986,26 +2977,22 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------------- */ static inline Tcl_Size -TclUpsizeAlloc( - TCL_UNUSED(Tcl_Size), /* oldSize. For future experiments with - * some growth algorithms that use this - * information. */ - Tcl_Size needed, - Tcl_Size limit) +TclUpsizeAlloc(TCL_UNUSED(Tcl_Size) /* oldSize. For future experiments with + * some growth algorithms that use this + * information. */, + Tcl_Size needed, + Tcl_Size limit) { /* assert (oldCapacity < needed <= limit) */ if (needed < (limit - needed/2)) { return needed + needed / 2; - } else { + } + else { return limit; } } -static inline Tcl_Size -TclUpsizeRetry( - Tcl_Size needed, - Tcl_Size lastAttempt) -{ - /* assert(needed < lastAttempt); */ +static inline Tcl_Size TclUpsizeRetry(Tcl_Size needed, Tcl_Size lastAttempt) { + /* assert (needed < lastAttempt) */ if (needed < lastAttempt - 1) { /* (needed+lastAttempt)/2 but that formula may overflow Tcl_Size */ return needed + (lastAttempt - needed) / 2; @@ -3013,58 +3000,37 @@ TclUpsizeRetry( return needed; } } -MODULE_SCOPE void * TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr); -MODULE_SCOPE void * TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount, - Tcl_Size elemSize, Tcl_Size leadSize, - Tcl_Size *capacityPtr); -MODULE_SCOPE void * TclAttemptReallocElemsEx(void *oldPtr, - Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr); +MODULE_SCOPE void *TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, + Tcl_Size leadSize, Tcl_Size *capacityPtr); +MODULE_SCOPE void *TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount, + Tcl_Size elemSize, Tcl_Size leadSize, + Tcl_Size *capacityPtr); +MODULE_SCOPE void *TclAttemptReallocElemsEx(void *oldPtr, + Tcl_Size elemCount, Tcl_Size elemSize, + Tcl_Size leadSize, Tcl_Size *capacityPtr); /* Alloc elemCount elements of size elemSize with leadSize header * returning actual capacity (in elements) in *capacityPtr. */ -static inline void * -TclAttemptAllocElemsEx( - Tcl_Size elemCount, - Tcl_Size elemSize, - Tcl_Size leadSize, - Tcl_Size *capacityPtr) -{ +static inline void *TclAttemptAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, + Tcl_Size leadSize, Tcl_Size *capacityPtr) { return TclAttemptReallocElemsEx( - NULL, elemCount, elemSize, leadSize, capacityPtr); + NULL, elemCount, elemSize, leadSize, capacityPtr); } /* Alloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void * -TclAllocEx( - Tcl_Size numBytes, - Tcl_Size *capacityPtr) -{ +static inline void *TclAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) { return TclAllocElemsEx(numBytes, 1, 0, capacityPtr); } /* Alloc numByte bytes, returning actual capacity in *capacityPtr. */ static inline void * -TclAttemptAllocEx( - Tcl_Size numBytes, - Tcl_Size *capacityPtr) +TclAttemptAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) { return TclAttemptAllocElemsEx(numBytes, 1, 0, capacityPtr); } /* Realloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void * -TclReallocEx( - void *oldPtr, - Tcl_Size numBytes, - Tcl_Size *capacityPtr) -{ +static inline void *TclReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) { return TclReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr); } /* Realloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void * -TclAttemptReallocEx( - void *oldPtr, - Tcl_Size numBytes, - Tcl_Size *capacityPtr) -{ +static inline void *TclAttemptReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) { return TclAttemptReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr); } @@ -3085,12 +3051,13 @@ MODULE_SCOPE TclPlatformType tclPlatform; MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; MODULE_SCOPE Tcl_Encoding tclUtf8Encoding; -MODULE_SCOPE int TclEncodingProfileNameToId(Tcl_Interp *interp, - const char *profileName, - int *profilePtr); +MODULE_SCOPE int +TclEncodingProfileNameToId(Tcl_Interp *interp, + const char *profileName, + int *profilePtr); MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp, - int profileId); -MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); + int profileId); +MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); /* * TIP #233 (Virtualized Time) @@ -3188,13 +3155,12 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke; MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues; -MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, - Tcl_Obj *tailcallPtr); -MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); +MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); +MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); /* These two can be considered for the public api */ -MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); -MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); /* * This structure holds the data for the various iteration callbacks used to @@ -3211,7 +3177,7 @@ typedef struct ForIterData { Tcl_Obj *body; /* Loop body. */ Tcl_Obj *next; /* Loop step script, NULL for 'while'. */ const char *msg; /* Error message part. */ - Tcl_Size word; /* Index of the body script in the command */ + Tcl_Size word; /* Index of the body script in the command */ } ForIterData; /* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile @@ -3219,9 +3185,9 @@ typedef struct ForIterData { * typedef in tcl.h */ typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, - const char* symbol); + const char* symbol); struct Tcl_LoadHandle_ { - void *clientData; /* Client data is the load handle in the + void *clientData; /* Client data is the load handle in the * native filesystem if a module was loaded * there, or an opaque pointer to a structure * for further bookkeeping on load-from-VFS @@ -3235,12 +3201,16 @@ struct Tcl_LoadHandle_ { /* Flags for conversion of doubles to digit strings */ -#define TCL_DD_E_FORMAT 0x2 /* Use a fixed-length string of digits, +#define TCL_DD_E_FORMAT 0x2 + /* Use a fixed-length string of digits, * suitable for E format*/ -#define TCL_DD_F_FORMAT 0x3 /* Use a fixed number of digits after the +#define TCL_DD_F_FORMAT 0x3 + /* Use a fixed number of digits after the * decimal point, suitable for F format */ -#define TCL_DD_SHORTEST 0x4 /* Use the shortest possible string */ -#define TCL_DD_NO_QUICK 0x8 /* Debug flag: forbid quick FP conversion */ +#define TCL_DD_SHORTEST 0x4 + /* Use the shortest possible string */ +#define TCL_DD_NO_QUICK 0x8 + /* Debug flag: forbid quick FP conversion */ #define TCL_DD_CONVERSION_TYPE_MASK 0x3 /* Mask to isolate the conversion type */ @@ -3266,8 +3236,7 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, Tcl_Obj *objv[], int objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, - void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, - Tcl_Size pc); + void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, @@ -3340,8 +3309,7 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp, - Tcl_Obj *const *objv, Tcl_Size objc, - Tcl_Size *objcPtr); + Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size *objcPtr); MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp); MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); @@ -3456,7 +3424,7 @@ MODULE_SCOPE Tcl_Size TclMaxListLength(const char *bytes, Tcl_Size numBytes, MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr); -MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); +MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); MODULE_SCOPE int TclNokia770Doubles(void); MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr); @@ -3481,16 +3449,15 @@ MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, MODULE_SCOPE void TclUndoRefCount(Tcl_Obj *objPtr); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); -MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, +MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); -MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, - Tcl_Obj **arithSeriesPtr, - int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, - Tcl_Obj *stepObj, Tcl_Obj *lenObj); +MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr, + int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, + Tcl_Obj *stepObj, Tcl_Obj *lenObj); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, Tcl_Size len); MODULE_SCOPE void TclpAlertNotifier(void *clientData); -MODULE_SCOPE void * TclpNotifierData(void); +MODULE_SCOPE void *TclpNotifierData(void); MODULE_SCOPE void TclpServiceModeHook(int mode); MODULE_SCOPE void TclpSetTimer(const Tcl_Time *timePtr); MODULE_SCOPE int TclpWaitForEvent(const Tcl_Time *timePtr); @@ -3520,7 +3487,7 @@ MODULE_SCOPE Tcl_Size TclpFindVariable(const char *name, Tcl_Size *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); -MODULE_SCOPE void * TclpInitNotifier(void); +MODULE_SCOPE void *TclpInitNotifier(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void); @@ -3602,14 +3569,13 @@ MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Size count, int *tokensLeftPtr, Tcl_Size line, Tcl_Size *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_Size TclTrim(const char *bytes, Tcl_Size numBytes, - const char *trim, Tcl_Size numTrim, - Tcl_Size *trimRight); + const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight); MODULE_SCOPE Tcl_Size TclTrimLeft(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE Tcl_Size TclTrimRight(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); -MODULE_SCOPE int TclObjInterpProc(void *clientData, +MODULE_SCOPE int TclObjInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclRegisterCommandTypeName( @@ -3635,16 +3601,16 @@ MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); #ifdef TCL_WIDE_CLICKS -MODULE_SCOPE long long TclpGetWideClicks(void); +MODULE_SCOPE long long TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(long long clicks); MODULE_SCOPE double TclpWideClickInMicrosec(void); #else # ifdef _WIN32 # define TCL_WIDE_CLICKS 1 -MODULE_SCOPE long long TclpGetWideClicks(void); +MODULE_SCOPE long long TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClickInMicrosec(void); -# define TclpWideClicksToNanoseconds(clicks) \ - ((double)(clicks) * TclpWideClickInMicrosec() * 1000) +# define TclpWideClicksToNanoseconds(clicks) \ + ((double)(clicks) * TclpWideClickInMicrosec() * 1000) # endif #endif MODULE_SCOPE long long TclpGetMicroseconds(void); @@ -3668,8 +3634,8 @@ MODULE_SCOPE void TclZipfsFinalize(void); */ MODULE_SCOPE int TclIsSpaceProc(int byte); -#define TclIsSpaceProcM(byte) \ - (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte)) +# define TclIsSpaceProcM(byte) \ + (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte)) /* *---------------------------------------------------------------- @@ -4038,13 +4004,14 @@ MODULE_SCOPE int TclFullFinalizationRequested(void); * TIP #542 */ -MODULE_SCOPE size_t TclUniCharLen(const Tcl_UniChar *uniStr); -MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); -MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); -MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, - const Tcl_UniChar *uniPattern, int nocase); +MODULE_SCOPE size_t TclUniCharLen(const Tcl_UniChar *uniStr); +MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, + const Tcl_UniChar *uniPattern, int nocase); + /* * Just for the purposes of command-type registration. @@ -4103,14 +4070,13 @@ MODULE_SCOPE Tcl_Size TclIndexDecode(int encoded, Tcl_Size endValue); /* * Error message utility functions */ -MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, - Tcl_Size count); +MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count); #endif /* TCL_MAJOR_VERSION > 8 */ /* Constants used in index value encoding routines. */ -#define TCL_INDEX_END ((Tcl_Size)-2) -#define TCL_INDEX_START ((Tcl_Size)0) +#define TCL_INDEX_END ((Tcl_Size)-2) +#define TCL_INDEX_START ((Tcl_Size)0) /* *---------------------------------------------------------------------- @@ -4189,20 +4155,20 @@ TclScaleTime( # define TclIncrObjsFreed() #endif /* TCL_COMPILE_STATS */ -# define TclAllocObjStorage(objPtr) \ +# define TclAllocObjStorage(objPtr) \ TclAllocObjStorageEx(NULL, (objPtr)) -# define TclFreeObjStorage(objPtr) \ +# define TclFreeObjStorage(objPtr) \ TclFreeObjStorageEx(NULL, (objPtr)) #ifndef TCL_MEM_DEBUG # define TclNewObj(objPtr) \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = &tclEmptyString; \ - (objPtr)->length = 0; \ - (objPtr)->typePtr = NULL; \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = &tclEmptyString; \ + (objPtr)->length = 0; \ + (objPtr)->typePtr = NULL; \ TCL_DTRACE_OBJ_CREATE(objPtr) /* @@ -4213,19 +4179,19 @@ TclScaleTime( */ # define TclDecrRefCount(objPtr) \ - if ((objPtr)->refCount-- > 1) ; else { \ - if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ - TCL_DTRACE_OBJ_FREE(objPtr); \ - if ((objPtr)->bytes \ - && ((objPtr)->bytes != &tclEmptyString)) { \ - Tcl_Free((objPtr)->bytes); \ - } \ - (objPtr)->length = TCL_INDEX_NONE; \ - TclFreeObjStorage(objPtr); \ - TclIncrObjsFreed(); \ - } else { \ - TclFreeObj(objPtr); \ - } \ + if ((objPtr)->refCount-- > 1) ; else { \ + if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ + TCL_DTRACE_OBJ_FREE(objPtr); \ + if ((objPtr)->bytes \ + && ((objPtr)->bytes != &tclEmptyString)) { \ + Tcl_Free((objPtr)->bytes); \ + } \ + (objPtr)->length = TCL_INDEX_NONE; \ + TclFreeObjStorage(objPtr); \ + TclIncrObjsFreed(); \ + } else { \ + TclFreeObj(objPtr); \ + } \ } #if TCL_THREADS && !defined(USE_THREAD_ALLOC) @@ -4332,11 +4298,11 @@ MODULE_SCOPE Tcl_Mutex tclObjMutex; } while (0) # define TclFreeObjStorageEx(interp, objPtr) \ - do { \ - Tcl_MutexLock(&tclObjMutex); \ + do { \ + Tcl_MutexLock(&tclObjMutex); \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \ - tclFreeObjList = (objPtr); \ - Tcl_MutexUnlock(&tclObjMutex); \ + tclFreeObjList = (objPtr); \ + Tcl_MutexUnlock(&tclObjMutex); \ } while (0) #endif @@ -4387,26 +4353,27 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclInitEmptyStringRep(objPtr) \ - ((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0)) + ((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0)) + #define TclInitStringRep(objPtr, bytePtr, len) \ - if ((len) == 0) { \ - TclInitEmptyStringRep(objPtr); \ - } else { \ - (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \ + if ((len) == 0) { \ + TclInitEmptyStringRep(objPtr); \ + } else { \ + (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \ memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \ - (objPtr)->bytes[len] = '\0'; \ - (objPtr)->length = (len); \ + (objPtr)->bytes[len] = '\0'; \ + (objPtr)->length = (len); \ } #define TclAttemptInitStringRep(objPtr, bytePtr, len) \ - ((((len) == 0) ? ( \ - TclInitEmptyStringRep(objPtr) \ - ) : ( \ - (objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \ - (objPtr)->length = ((objPtr)->bytes) ? \ + ((((len) == 0) ? ( \ + TclInitEmptyStringRep(objPtr) \ + ) : ( \ + (objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \ + (objPtr)->length = ((objPtr)->bytes) ? \ (memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)), \ - (objPtr)->bytes[len] = '\0', (len)) : (-1) \ + (objPtr)->bytes[len] = '\0', (len)) : (-1) \ )), (objPtr)->bytes) /* @@ -4425,8 +4392,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) #define TclGetStringFromObj(objPtr, lenPtr) \ - ((objPtr)->bytes \ - ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ + ((objPtr)->bytes \ + ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ : (Tcl_GetStringFromObj)((objPtr), (lenPtr))) /* @@ -4440,11 +4407,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclFreeInternalRep(objPtr) \ - if ((objPtr)->typePtr != NULL) { \ - if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ - (objPtr)->typePtr->freeIntRepProc(objPtr); \ - } \ - (objPtr)->typePtr = NULL; \ + if ((objPtr)->typePtr != NULL) { \ + if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ + (objPtr)->typePtr->freeIntRepProc(objPtr); \ + } \ + (objPtr)->typePtr = NULL; \ } /* @@ -4457,14 +4424,14 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclInvalidateStringRep(objPtr) \ - do { \ - Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ - if (_isobjPtr->bytes != NULL) { \ - if (_isobjPtr->bytes != &tclEmptyString) { \ - Tcl_Free((char *)_isobjPtr->bytes); \ - } \ - _isobjPtr->bytes = NULL; \ - } \ + do { \ + Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ + if (_isobjPtr->bytes != NULL) { \ + if (_isobjPtr->bytes != &tclEmptyString) { \ + Tcl_Free((char *)_isobjPtr->bytes); \ + } \ + _isobjPtr->bytes = NULL; \ + } \ } while (0) /* @@ -4507,8 +4474,8 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; #define TclUnpackBignum(objPtr, bignum) \ do { \ - Tcl_Obj *bignumObj = (objPtr); \ - int bignumPayload = \ + Tcl_Obj *bignumObj = (objPtr); \ + int bignumPayload = \ PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \ if (bignumPayload == -1) { \ (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \ @@ -4561,16 +4528,16 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; oldPtr = NULL; \ } \ newPtr = (Tcl_Token *)Tcl_AttemptRealloc((char *) oldPtr, \ - allocated * sizeof(Tcl_Token)); \ + allocated * sizeof(Tcl_Token)); \ if (newPtr == NULL) { \ allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH; \ newPtr = (Tcl_Token *)Tcl_Realloc((char *) oldPtr, \ - allocated * sizeof(Tcl_Token)); \ + allocated * sizeof(Tcl_Token)); \ } \ (available) = allocated; \ if (oldPtr == NULL) { \ memcpy(newPtr, staticPtr, \ - (used) * sizeof(Tcl_Token)); \ + (used) * sizeof(Tcl_Token)); \ } \ (tokenPtr) = newPtr; \ } \ @@ -4594,8 +4561,8 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; */ #define TclUtfToUniChar(str, chPtr) \ - (((UCHAR(*(str))) < 0x80) ? \ - ((*(chPtr) = UCHAR(*(str))), 1) \ + (((UCHAR(*(str))) < 0x80) ? \ + ((*(chPtr) = UCHAR(*(str))), 1) \ : Tcl_UtfToUniChar(str, chPtr)) /* @@ -4612,15 +4579,15 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; */ #define TclNumUtfCharsM(numChars, bytes, numBytes) \ - do { \ - Tcl_Size _count, _i = (numBytes); \ - unsigned char *_str = (unsigned char *) (bytes); \ - while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ - _count = (numBytes) - _i; \ - if (_i) { \ - _count += Tcl_NumUtfChars((bytes) + _count, _i); \ - } \ - (numChars) = _count; \ + do { \ + Tcl_Size _count, _i = (numBytes); \ + unsigned char *_str = (unsigned char *) (bytes); \ + while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ + _count = (numBytes) - _i; \ + if (_i) { \ + _count += Tcl_NumUtfChars((bytes) + _count, _i); \ + } \ + (numChars) = _count; \ } while (0); /* @@ -4640,11 +4607,12 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ - (((objPtr)->bytes == NULL) && TclHasInternalRep((objPtr), &tclDictType)) + (((objPtr)->bytes==NULL) && TclHasInternalRep((objPtr), &tclDictType)) #define TclHasInternalRep(objPtr, type) \ - ((objPtr)->typePtr == (type)) + ((objPtr)->typePtr == (type)) #define TclFetchInternalRep(objPtr, type) \ - (TclHasInternalRep((objPtr), (type)) ? &(objPtr)->internalRep : NULL) + (TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL) + /* *---------------------------------------------------------------- @@ -4690,6 +4658,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init; MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; + /* *---------------------------------------------------------------- * Macro used by the Tcl core to check whether a pattern has any characters @@ -4715,18 +4684,18 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; */ #define TclSetIntObj(objPtr, i) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.wideValue = (Tcl_WideInt) i; \ - TclInvalidateStringRep(objPtr); \ - Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.wideValue = (Tcl_WideInt) i; \ + TclInvalidateStringRep(objPtr); \ + Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \ } while (0) #define TclSetDoubleObj(objPtr, d) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.doubleValue = (double) d; \ - TclInvalidateStringRep(objPtr); \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.doubleValue = (double) d; \ + TclInvalidateStringRep(objPtr); \ Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir); \ } while (0) @@ -4746,58 +4715,58 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; #ifndef TCL_MEM_DEBUG #define TclNewIntObj(objPtr, w) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ - (objPtr)->typePtr = &tclIntType; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ + (objPtr)->typePtr = &tclIntType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewUIntObj(objPtr, uw) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - Tcl_WideUInt uw_ = (uw); \ - if (uw_ > WIDE_MAX) { \ - mp_int bignumValue_; \ - if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + Tcl_WideUInt uw_ = (uw); \ + if (uw_ > WIDE_MAX) { \ + mp_int bignumValue_; \ + if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \ Tcl_Panic("%s: memory overflow", "TclNewUIntObj"); \ - } \ - TclSetBignumInternalRep((objPtr), &bignumValue_); \ - } else { \ + } \ + TclSetBignumInternalRep((objPtr), &bignumValue_); \ + } else { \ (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \ - (objPtr)->typePtr = &tclIntType; \ - } \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + (objPtr)->typePtr = &tclIntType; \ + } \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewIndexObj(objPtr, w) \ TclNewIntObj(objPtr, w) #define TclNewDoubleObj(objPtr, d) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.doubleValue = (double)(d); \ - (objPtr)->typePtr = &tclDoubleType; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.doubleValue = (double)(d); \ + (objPtr)->typePtr = &tclDoubleType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewStringObj(objPtr, s, len) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - TclInitStringRep((objPtr), (s), (len)); \ - (objPtr)->typePtr = NULL; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + TclInitStringRep((objPtr), (s), (len)); \ + (objPtr)->typePtr = NULL; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #else /* TCL_MEM_DEBUG */ @@ -4805,18 +4774,18 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; (objPtr) = Tcl_NewWideIntObj(w) #define TclNewUIntObj(objPtr, uw) \ - do { \ - Tcl_WideUInt uw_ = (uw); \ - if (uw_ > WIDE_MAX) { \ - mp_int bignumValue_; \ - if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) { \ - (objPtr) = Tcl_NewBignumObj(&bignumValue_); \ - } else { \ - (objPtr) = NULL; \ - } \ - } else { \ - (objPtr) = Tcl_NewWideIntObj(uw_); \ - } \ + do { \ + Tcl_WideUInt uw_ = (uw); \ + if (uw_ > WIDE_MAX) { \ + mp_int bignumValue_; \ + if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) { \ + (objPtr) = Tcl_NewBignumObj(&bignumValue_); \ + } else { \ + (objPtr) = NULL; \ + } \ + } else { \ + (objPtr) = Tcl_NewWideIntObj(uw_); \ + } \ } while (0) #define TclNewIndexObj(objPtr, w) \ @@ -4868,26 +4837,28 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; * the internal stubs, but the core can use the macro instead. */ -#define TclCleanupCommandMacro(cmdPtr) \ +#define TclCleanupCommandMacro(cmdPtr) \ do { \ if ((cmdPtr)->refCount-- <= 1) { \ Tcl_Free(cmdPtr); \ } \ } while (0) + /* * inside this routine crement refCount first incase cmdPtr is replacing itself */ -#define TclRoutineAssign(location, cmdPtr) \ - do { \ - (cmdPtr)->refCount++; \ - if ((location) != NULL \ - && (location--) <= 1) { \ - Tcl_Free(((location))); \ - } \ - (location) = (cmdPtr); \ +#define TclRoutineAssign(location, cmdPtr) \ + do { \ + (cmdPtr)->refCount++; \ + if ((location) != NULL \ + && (location--) <= 1) { \ + Tcl_Free(((location))); \ + } \ + (location) = (cmdPtr); \ } while (0) + #define TclRoutineHasName(cmdPtr) \ ((cmdPtr)->hPtr != NULL) @@ -4900,10 +4871,9 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; * to the non-inline version. */ -#define TclLimitExceeded(limit) \ - ((limit).exceeded != 0) +#define TclLimitExceeded(limit) ((limit).exceeded != 0) -#define TclLimitReady(limit) \ +#define TclLimitReady(limit) \ (((limit).active == 0) ? 0 : \ (++(limit).granularityTicker, \ ((((limit).active & TCL_LIMIT_COMMANDS) && \ @@ -5021,8 +4991,7 @@ typedef struct NRE_callback { struct NRE_callback *nextPtr; } NRE_callback; -#define TOP_CB(iPtr) \ - (((Interp *)(iPtr))->execEnvPtr->callbackPtr) +#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr) /* * Inline version of Tcl_NRAddCallback. @@ -5061,9 +5030,9 @@ typedef struct NRE_callback { #include "tclIntPlatDecls.h" #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) -#define Tcl_AttemptAlloc TclpAlloc -#define Tcl_AttemptRealloc TclpRealloc -#define Tcl_Free TclpFree +#define Tcl_AttemptAlloc TclpAlloc +#define Tcl_AttemptRealloc TclpRealloc +#define Tcl_Free TclpFree #endif /* diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 5fbefbf..b2d883b 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -186,7 +186,7 @@ struct LimitHandler { int flags; /* The state of this particular handler. */ Tcl_LimitHandlerProc *handlerProc; /* The handler callback. */ - void *clientData; /* Opaque argument to the handler callback. */ + void *clientData; /* Opaque argument to the handler callback. */ Tcl_LimitHandlerDeleteProc *deleteProc; /* How to delete the clientData. */ LimitHandler *prevPtr; /* Previous item in linked list of @@ -207,6 +207,8 @@ struct LimitHandler { #define LIMIT_HANDLER_ACTIVE 0x01 #define LIMIT_HANDLER_DELETED 0x02 + + /* * Prototypes for local static functions: */ @@ -275,6 +277,7 @@ static void TimeLimitCallback(void *clientData); static Tcl_NRPostProc NRPostInvokeHidden; static Tcl_ObjCmdProc NRInterpCmd; static Tcl_ObjCmdProc NRChildCmd; + /* *---------------------------------------------------------------------- diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 1bb3587..2d925e7 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1616,7 +1616,8 @@ Tcl_Obj * TclListObjGetElement( Tcl_Obj *objPtr, /* List object for which an element array is * to be returned. */ - Tcl_Size index) + Tcl_Size index +) { return ListObjStorePtr(objPtr)->slots[ListObjStart(objPtr) + index]; } @@ -2017,6 +2018,7 @@ Tcl_ListObjLength( return TCL_OK; } + if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { return TCL_ERROR; } @@ -3550,6 +3552,7 @@ UpdateStringOfList( Tcl_Free(flagPtr); } } + /* *------------------------------------------------------------------------ diff --git a/generic/tclLoad.c b/generic/tclLoad.c index c5a181d..d7c13d1 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -12,6 +12,7 @@ #include "tclInt.h" + /* * The following structure describes a library that has been loaded either * dynamically (with the "load" command) or statically (as indicated by a call @@ -95,6 +96,7 @@ static int IsStatic(LoadedLibrary *libraryPtr); static int UnloadLibrary(Tcl_Interp *interp, Tcl_Interp *target, LoadedLibrary *library, int keepLibrary, const char *fullFileName, int interpExiting); + static int IsStatic( @@ -142,7 +144,7 @@ Tcl_LoadObjCmd( int flags = 0; Tcl_Obj *const *savedobjv = objv; static const char *const options[] = { - "-global", "-lazy", "--", NULL + "-global", "-lazy", "--", NULL }; enum loadOptionsEnum { LOAD_GLOBAL, LOAD_LAZY, LOAD_LAST @@ -166,8 +168,7 @@ Tcl_LoadObjCmd( } } if ((objc < 2) || (objc > 4)) { - Tcl_WrongNumArgs(interp, 1, savedobjv, - "?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"); + Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { @@ -752,6 +753,7 @@ Tcl_UnloadObjCmd( } return code; } + /* *---------------------------------------------------------------------- @@ -771,12 +773,13 @@ Tcl_UnloadObjCmd( */ static int UnloadLibrary( - Tcl_Interp *interp, - Tcl_Interp *target, - LoadedLibrary *libraryPtr, - int keepLibrary, - const char *fullFileName, - int interpExiting) + Tcl_Interp *interp, + Tcl_Interp *target, + LoadedLibrary *libraryPtr, + int keepLibrary, + const char *fullFileName, + int interpExiting +) { int code; InterpLibrary *ipFirstPtr, *ipPtr; @@ -818,6 +821,8 @@ UnloadLibrary( unloadProc = libraryPtr->unloadProc; } + + /* * We are ready to unload the library. First, evaluate the unload * function. If this fails, we cannot proceed with unload. Also, we must @@ -851,11 +856,13 @@ UnloadLibrary( code = unloadProc(target, code); } + if (code != TCL_OK) { Tcl_TransferResult(target, code, interp); goto done; } + /* * Remove this library from the interpreter's library cache. */ @@ -878,6 +885,7 @@ UnloadLibrary( Tcl_Free(ipPtr); Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); + if (IsStatic(libraryPtr)) { goto done; } @@ -1099,8 +1107,9 @@ TclGetLoadedLibraries( * NULL, return info about all interps; * otherwise, just return info about this * interpreter. */ - const char *prefix) /* Prefix or NULL. If NULL, return info - * for all prefixes. */ + const char *prefix) /* Prefix or NULL. If NULL, return info + * for all prefixes. + */ { Tcl_Interp *target; LoadedLibrary *libraryPtr; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index eebf6aa..2a30742 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -1079,7 +1079,8 @@ TclNamespaceDeleted( void TclDeleteNamespaceChildren( - Namespace *nsPtr) /* Namespace whose children to delete */ + Namespace *nsPtr /* Namespace whose children to delete */ +) { Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; @@ -3961,6 +3962,7 @@ NamespaceOriginCmd( Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } + /* *---------------------------------------------------------------------- @@ -5154,6 +5156,7 @@ Tcl_LogCommandInfo( { TclLogCommandInfo(interp, script, command, length, NULL, NULL); } + /* * Local Variables: diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 46ee8be..7695483 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -155,6 +155,7 @@ static const Tcl_ObjType methodNameType = { NULL, TCL_OBJTYPE_V0 }; + /* * ---------------------------------------------------------------------- diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 2e40d5b..c5bed43 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -733,7 +733,7 @@ TclOOMakeProcMethod( static int InvokeProcedureMethod( - void *clientData, /* Pointer to some per-method context. */ + void *clientData, /* Pointer to some per-method context. */ Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ diff --git a/generic/tclObj.c b/generic/tclObj.c index 36856d4..30634a0 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -349,6 +349,7 @@ typedef struct ResolvedCmdName { #define FREEDREFCOUNTFILLER \ (Tcl_Size)(sizeof(objPtr->refCount) == 4 ? 0xe8e8e8e8 : 0xe8e8e8e8e8e8e8e8) #endif + /* *------------------------------------------------------------------------- @@ -2567,6 +2568,7 @@ Tcl_GetIntFromObj( return TCL_OK; #endif } + /* *---------------------------------------------------------------------- diff --git a/generic/tclPanic.c b/generic/tclPanic.c index ed12640..dcceb25 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -81,6 +81,7 @@ Tcl_Panic( * to pass to fprintf. */ char *arg4, *arg5, *arg6, *arg7, *arg8; + va_start(argList, format); arg1 = va_arg(argList, char *); arg2 = va_arg(argList, char *); diff --git a/generic/tclParse.c b/generic/tclParse.c index e88de0b..13e5c1e 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -1396,7 +1396,7 @@ Tcl_ParseVarName( case '}': braceCount--; break; case '\\': /* if 2 or more left, consume 2, else consume - * just the \ and let it run into the end */ + just the \ and let it run into the end */ if (numBytes > 1) { src++; numBytes--; } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 9a44863..80954bc 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -1519,6 +1519,7 @@ Tcl_FSNewNativePath( Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; + if (fromFilesystem->internalToNormalizedProc != NULL) { pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); } @@ -2688,6 +2689,7 @@ TclResolveTildePathList( return resolvedPaths; } + /* * Local Variables: diff --git a/generic/tclProc.c b/generic/tclProc.c index 2f87048..40c6f32 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -69,7 +69,7 @@ const Tcl_ObjType tclProcBodyType = { TCL_OBJTYPE_V0 }; -#define ProcSetInternalRep(objPtr, procPtr) \ +#define ProcSetInternalRep(objPtr, procPtr) \ do { \ Tcl_ObjInternalRep ir; \ (procPtr)->refCount++; \ @@ -78,11 +78,11 @@ const Tcl_ObjType tclProcBodyType = { Tcl_StoreInternalRep((objPtr), &tclProcBodyType, &ir); \ } while (0) -#define ProcGetInternalRep(objPtr, procPtr) \ +#define ProcGetInternalRep(objPtr, procPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \ - (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -116,22 +116,23 @@ static const Tcl_ObjType lambdaType = { TCL_OBJTYPE_V0 }; -#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \ +#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (procPtr); \ ir.twoPtrValue.ptr2 = (nsObjPtr); \ Tcl_IncrRefCount((nsObjPtr)); \ - Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \ + Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \ } while (0) -#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \ +#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &lambdaType); \ - (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ - (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &lambdaType); \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ + (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) + /* *---------------------------------------------------------------------- @@ -155,7 +156,7 @@ int Tcl_ProcObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -1094,8 +1095,7 @@ ProcWrongNumArgs( if (defPtr->value.objPtr != NULL) { TclNewObj(argObj); - Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", - (void *)NULL); + Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", (void *)NULL); } else if (defPtr->flags & VAR_IS_ARGS) { numArgs--; final = "?arg ...?"; @@ -1339,7 +1339,7 @@ InitLocalCache( static int InitArgsAndLocals( - Tcl_Interp *interp, /* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int skip) /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ @@ -1503,9 +1503,9 @@ InitArgsAndLocals( int TclPushProcCallFrame( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp, /* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ Tcl_Size objc, /* Count of number of arguments to this * procedure. */ @@ -1597,9 +1597,9 @@ TclPushProcCallFrame( int TclObjInterpProc( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp, /* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ @@ -1614,11 +1614,11 @@ TclObjInterpProc( int TclNRInterpProc( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp, /* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ - Tcl_Size objc, /* Count of number of arguments to this + Tcl_Size objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1637,7 +1637,7 @@ NRInterpProc( * interpreted. */ Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ - int objc, /* Count of number of arguments to this + int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1666,6 +1666,7 @@ ObjInterpProc2( return Tcl_NRCallObjProc2(interp, TclNRInterpProc, clientData, objc, objv); } + /* *---------------------------------------------------------------------- @@ -1687,10 +1688,10 @@ ObjInterpProc2( int TclNRInterpProcCore( - Tcl_Interp *interp, /* Interpreter in which procedure was + Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ - Tcl_Size skip, /* Number of initial arguments to be skipped, + Tcl_Size skip, /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ ProcErrorProc *errorProc) /* How to convert results from the script into * results of the overall procedure. */ @@ -2136,7 +2137,7 @@ TclProcDeleteProc( void TclProcCleanupProc( - Proc *procPtr) /* Procedure to be deleted. */ + Proc *procPtr) /* Procedure to be deleted. */ { CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; @@ -2401,7 +2402,7 @@ ProcBodyFree( static void DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; @@ -2416,7 +2417,7 @@ DupLambdaInternalRep( static void FreeLambdaInternalRep( - Tcl_Obj *objPtr) /* CmdName object with internal representation + Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { Proc *procPtr; @@ -2434,7 +2435,7 @@ FreeLambdaInternalRep( static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; diff --git a/generic/tclProcess.c b/generic/tclProcess.c index a5607d9..968e191 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -350,6 +350,7 @@ WaitProcessStatus( } } + /* *---------------------------------------------------------------------- * @@ -890,7 +891,8 @@ TclProcessWait( * - errno in case of error. * - non-zero exit code for abormal exit. * - signal number if killed or suspended. - * - Tcl_WaitPid status in all other cases. */ + * - Tcl_WaitPid status in all other cases. + */ Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */ Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */ { diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 04f060b..bc6468d 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -111,21 +111,22 @@ const Tcl_ObjType tclRegexpType = { TCL_OBJTYPE_V0 }; -#define RegexpSetInternalRep(objPtr, rePtr) \ +#define RegexpSetInternalRep(objPtr, rePtr) \ do { \ Tcl_ObjInternalRep ir; \ (rePtr)->refCount++; \ ir.twoPtrValue.ptr1 = (rePtr); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &tclRegexpType, &ir); \ + Tcl_StoreInternalRep((objPtr), &tclRegexpType, &ir); \ } while (0) -#define RegexpGetInternalRep(objPtr, rePtr) \ +#define RegexpGetInternalRep(objPtr, rePtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &tclRegexpType); \ - (rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \ + (rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) + /* *---------------------------------------------------------------------- @@ -222,8 +223,8 @@ Tcl_RegExpExec( Tcl_DStringInit(&ds); ustr = Tcl_UtfToUniCharDString(text, TCL_INDEX_NONE, &ds); numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar); - result = RegExpExecUniChar(interp, re, ustr, numChars, - TCL_INDEX_NONE /* nmatches */, flags); + result = RegExpExecUniChar(interp, re, ustr, numChars, TCL_INDEX_NONE /* nmatches */, + flags); Tcl_DStringFree(&ds); return result; @@ -305,7 +306,7 @@ RegExpExecUniChar( * previous call to Tcl_GetRegExpFromObj */ const Tcl_UniChar *wString, /* String against which to match re. */ size_t numChars, /* Length of Tcl_UniChar string. */ - size_t nm, /* How many subexpression matches (counting + size_t nm, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means "don't know". */ int flags) /* Regular expression flags. */ @@ -366,9 +367,9 @@ TclRegExpRangeUniChar( * > 0 means give the range of a matching * subrange, -1 means the range of the * rm_extend field. */ - Tcl_Size *startPtr, /* Store address of first character in + Tcl_Size *startPtr, /* Store address of first character in * (sub-)range here. */ - Tcl_Size *endPtr) /* Store address of character just after last + Tcl_Size *endPtr) /* Store address of character just after last * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; @@ -444,7 +445,7 @@ Tcl_RegExpExecObj( Tcl_Obj *textObj, /* Text against which to match re. */ Tcl_Size offset, /* Character index that marks where matching * should begin. */ - Tcl_Size nmatches, /* How many subexpression matches (counting + Tcl_Size nmatches, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means all of them. */ int flags) /* Regular expression execution flags. */ @@ -858,7 +859,7 @@ static TclRegexp * CompileRegexp( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ const char *string, /* The regexp to compile (UTF-8). */ - size_t length, /* The length of the string in bytes. */ + size_t length, /* The length of the string in bytes. */ int flags) /* Compilation flags. */ { TclRegexp *regexpPtr; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 1b78184..87aab60 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -26,6 +26,7 @@ # define PRIx64 TCL_LL_MODIFIER "x" #endif + /* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be @@ -4229,6 +4230,7 @@ StrictBignumConversion( * Extract the next group of digits. */ + if ((err != MP_OKAY) || (mp_div(&b, &S, &dig, &b) != MP_OKAY) || (dig.used > 1)) { Tcl_Panic("wrong digit!"); } @@ -4846,6 +4848,7 @@ TclBignumToDouble( mp_err err; const mp_int *a = (const mp_int *)big; + /* * We need a 'mantBits'-bit significand. Determine what shift will * give us that. diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 05c578e..73391fe 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -459,6 +459,7 @@ TclGetCharLength( return numChars; } + /* *---------------------------------------------------------------------- * @@ -3519,6 +3520,7 @@ TclStringCat( *--------------------------------------------------------------------------- */ + static int UniCharNcasememcmp( const void *ucsPtr, /* Unicode string to compare to uct. */ diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index a7bca14..4e38a64 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -18,6 +18,7 @@ #ifndef _TCLSTRINGREP #define _TCLSTRINGREP + /* * The following structure is the internal rep for a String object. It keeps * track of how much memory has been used and how much has been allocated for diff --git a/generic/tclStubLibTbl.c b/generic/tclStubLibTbl.c index 6ac879c..ad34494 100644 --- a/generic/tclStubLibTbl.c +++ b/generic/tclStubLibTbl.c @@ -33,14 +33,14 @@ MODULE_SCOPE void *tclStubsHandle; */ MODULE_SCOPE const char * TclInitStubTable( - const char *version) /* points to the version field of a - * structure variable. */ + const char *version) /* points to the version field of a + structure variable. */ { if (version) { if (tclStubsHandle == NULL) { - /* This can only happen with -DBUILD_STATIC, so simulate - * that the loading of Tcl succeeded, although we didn't - * actually load it dynamically */ + /* This can only happen with -DBUILD_STATIC, so simulate + * that the loading of Tcl succeeded, although we didn't + * actually load it dynamically */ tclStubsHandle = (void *)1; } tclStubsPtr = ((const TclStubs **) version)[-1]; diff --git a/generic/tclThread.c b/generic/tclThread.c index c107780..698c642 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -145,6 +145,7 @@ RememberSyncObject( void **newList; int i, j; + /* * Reuse any free slot in the list. */ diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c index 492c95f..c0786c9 100644 --- a/generic/tclTomMathStubLib.c +++ b/generic/tclTomMathStubLib.c @@ -18,6 +18,7 @@ MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr; const TclTomMathStubs *tclTomMathStubsPtr = NULL; + /* *---------------------------------------------------------------------- * diff --git a/generic/tclTrace.c b/generic/tclTrace.c index f4e9fe5..33085f3 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1016,6 +1016,7 @@ Tcl_TraceCommand( cmdPtr->flags |= CMD_HAS_EXEC_TRACES; } + return TCL_OK; } diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 03ea8b6..e107081 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1717,6 +1717,7 @@ TclUtfCmp( } return UCHAR(*cs) - UCHAR(*ct); } + /* *---------------------------------------------------------------------- @@ -1756,6 +1757,7 @@ TclUtfCasecmp( } return UCHAR(*cs) - UCHAR(*ct); } + /* *---------------------------------------------------------------------- diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 3043fed..0c9a3b2 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2598,11 +2598,10 @@ char * Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *bytes, /* String to append. If length is - * TCL_INDEX_NONE then this must be - * null-terminated. */ + * TCL_INDEX_NONE then this must be null-terminated. */ Tcl_Size length) /* Number of bytes from "bytes" to append. If - * TCL_INDEX_NONE, then append all of bytes, up - * to null at end. */ + * TCL_INDEX_NONE, then append all of bytes, up to null + * at end. */ { Tcl_Size newSize; @@ -2618,6 +2617,7 @@ Tcl_DStringAppend( } newSize = length + dsPtr->length + 1; + if (newSize > dsPtr->spaceAvl) { if (dsPtr->string == dsPtr->staticSpace) { char *newString; diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index b0bb383..12f0ea0 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -217,9 +217,9 @@ typedef struct ZipEntry { ZipFile *zipFilePtr; /* The ZIP file holding this virtual file */ size_t offset; /* Data offset into memory mapped ZIP file */ int numBytes; /* Uncompressed size of the virtual file. - * -1 for zip64 */ + -1 for zip64 */ int numCompressedBytes; /* Compressed size of the virtual file. - * -1 for zip64 */ + -1 for zip64 */ int compressMethod; /* Compress method */ int isDirectory; /* 0 if file, 1 if directory, -1 if root */ int depth; /* Number of slashes in path. */ @@ -810,13 +810,11 @@ IsCryptHeaderValid( *------------------------------------------------------------------------ */ static int -DecodeCryptHeader( - Tcl_Interp *interp, - ZipEntry *z, - unsigned long keys[3], /* Updated on success. Must have been - * initialized by caller. */ - unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN]) - /* From zip file content */ +DecodeCryptHeader(Tcl_Interp *interp, + ZipEntry *z, + unsigned long keys[3],/* Updated on success. Must have been + initialized by caller. */ + unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN]) /* From zip file content */ { int i; int ch; @@ -1067,12 +1065,11 @@ errorReturn: *------------------------------------------------------------------------ */ static char * -MapPathToZipfs( - Tcl_Interp *interp, - const char *mountPath, /* Must be fully normalized */ - const char *path, /* Archive content path to map */ - Tcl_DString *dsPtr) /* Must be initialized and cleared - * by caller */ +MapPathToZipfs(Tcl_Interp *interp, + const char *mountPath, /* Must be fully normalized */ + const char *path, /* Archive content path to map */ + Tcl_DString *dsPtr) /* Must be initialized and cleared + by caller */ { const char *joiner[2]; char *joinedPath; diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index d8af241..9123656 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -846,6 +846,7 @@ StartNotifierThread(void) } UNLOCK_NOTIFIER_INIT; } + /* *---------------------------------------------------------------------- diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index ba49842..062139a 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -185,7 +185,8 @@ PlatformEventsControl( Tcl_Panic("fstat: %s", strerror(errno)); } else if ((fdStat.st_mode & S_IFMT) == S_IFREG || (fdStat.st_mode & S_IFMT) == S_IFDIR - || (fdStat.st_mode & S_IFMT) == S_IFLNK) { + || (fdStat.st_mode & S_IFMT) == S_IFLNK + ) { switch (op) { case EV_ADD: if (isNew) { diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index de185fb..12df7e4 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -14,6 +14,7 @@ #include #include + /* * Static procedures defined within this file. */ diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 81f314f..1c8b53a 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -36,6 +36,7 @@ #include #include + /* * Static procedures defined within this file. */ diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 81e3af5..67bff10 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -335,6 +335,7 @@ static int MacOSXGetLibraryPath(Tcl_Interp *interp, MODULE_SCOPE long tclMacOSXDarwinRelease; long tclMacOSXDarwinRelease = 0; #endif + /* *--------------------------------------------------------------------------- diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 4c08464..8715b4d 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -108,10 +108,10 @@ static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName, static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ - NULL, + NULL, NULL, /* Set option proc. */ FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ @@ -140,6 +140,7 @@ static const Tcl_ChannelType fileChannelType = { #define POSIX_EPOCH_AS_FILETIME \ ((long long) 116444736 * (long long) 1000000000) + /* *---------------------------------------------------------------------- diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 8b289b1..b7288b7 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -280,6 +280,7 @@ static Tcl_ThreadDataKey dataKey; */ SRWLOCK gConsoleLock; + /* Process-wide list of console handles. Access control through gConsoleLock */ static ConsoleHandleInfo *gConsoleHandleInfoList; @@ -904,7 +905,7 @@ ConsoleCheckProc( /* See note above loop why this can be accessed without locks */ chanInfoPtr->flags |= CONSOLE_EVENT_QUEUED; chanInfoPtr->numRefs += 1; /* So it does not go away while event - * is in queue */ + is in queue */ evPtr->header.proc = ConsoleEventProc; evPtr->chanInfoPtr = chanInfoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -972,7 +973,7 @@ ConsoleBlockModeProc( static int ConsoleCloseProc( - void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ + void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 0af484d..e7164df 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -53,6 +53,7 @@ enum { static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; + const char *const tclpFileAttrStrings[] = { "-archive", "-hidden", "-longname", "-readonly", "-shortname", "-system", NULL diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 9995602..6de1432 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -75,10 +75,11 @@ typedef struct TclPipeThreadInfo { * to do read/write operation. Additionally * used as signal to stop (state set to -1) */ volatile LONG state; /* Indicates current state of the thread */ - void *clientData; /* Referenced data of the main thread */ + void *clientData; /* Referenced data of the main thread */ HANDLE evWakeUp; /* Optional wake-up event worker set by shutdown */ } TclPipeThreadInfo; + /* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without * more overhead for finalize thread (should be executed anyway) * @@ -98,6 +99,7 @@ typedef struct TclPipeThreadInfo { #define PTI_STATE_END 4 /* thread should stop work (worker is busy) */ #define PTI_STATE_DOWN 8 /* worker is down */ + MODULE_SCOPE TclPipeThreadInfo * TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr, void *clientData, HANDLE wakeEvent); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index dbf3324..3f0269c 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1187,6 +1187,7 @@ TclpCreateProcess( } return result; } + /* *---------------------------------------------------------------------- diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 8ab4548..efd9ff2 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -246,6 +246,7 @@ typedef DWORD_PTR * PDWORD_PTR; # define EWOULDBLOCK 140 /* Operation would block */ #endif + /* Visual Studio doesn't have these, so just choose some high numbers */ #ifndef ESOCKTNOSUPPORT # define ESOCKTNOSUPPORT 240 /* Socket type not supported */ @@ -414,6 +415,7 @@ typedef DWORD_PTR * PDWORD_PTR; # endif #endif /* !S_ISLNK */ + /* * Define MAXPATHLEN in terms of MAXPATH if available */ @@ -522,6 +524,7 @@ typedef DWORD_PTR * PDWORD_PTR; /* This type is not defined in the Windows headers */ #define socklen_t int + /* * The following macros have trivial definitions, allowing generic code to * address platform-specific issues. diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index e27937e..d8193b4 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -613,6 +613,7 @@ SerialCloseProc( return EINVAL; } + if (serialPtr->validMask & TCL_READABLE) { PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR); CloseHandle(serialPtr->osRead.hEvent); @@ -1479,6 +1480,7 @@ TclWinOpenSerialChannel( infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, infoPtr, permissions); + SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite); PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR); diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index d5c582b..d99de8c 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -79,10 +79,10 @@ static CRITICAL_SECTION joinLock; #if TCL_THREADS typedef struct ThreadSpecificData { - HANDLE condEvent; /* Per-thread condition event */ + HANDLE condEvent; /* Per-thread condition event */ struct ThreadSpecificData *nextPtr; /* Queue pointers */ struct ThreadSpecificData *prevPtr; - int flags; /* See flags below */ + int flags; /* See flags below */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -120,7 +120,7 @@ typedef struct { static DWORD tlsKey; typedef struct { - Tcl_Mutex tlock; + Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; #endif /* USE_THREAD_ALLOC */ @@ -131,12 +131,12 @@ typedef struct { */ typedef struct { - LPTHREAD_START_ROUTINE lpStartAddress; - /* Original startup routine */ - LPVOID lpParameter; /* Original startup data */ - unsigned int fpControl; /* Floating point control word from the + LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */ + LPVOID lpParameter; /* Original startup data */ + unsigned int fpControl; /* Floating point control word from the * main thread */ } WinThread; + /* *---------------------------------------------------------------------- @@ -567,9 +567,9 @@ Tcl_MutexLock( */ if (*mutexPtr == NULL) { - csPtr = (CRITICAL_SECTION *) Tcl_Alloc(sizeof(CRITICAL_SECTION)); + csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); - *mutexPtr = (Tcl_Mutex) csPtr; + *mutexPtr = (Tcl_Mutex)csPtr; TclRememberMutex(mutexPtr); } TclpGlobalUnlock(); @@ -659,7 +659,7 @@ void Tcl_ConditionWait( Tcl_Condition *condPtr, /* Really (WinCondition **) */ Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */ - const Tcl_Time *timePtr) /* Timeout on waiting period */ + const Tcl_Time *timePtr) /* Timeout on waiting period */ { WinCondition *winCondPtr; /* Per-condition queue head */ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */ @@ -926,6 +926,9 @@ TclpFinalizeCondition( } } + + + /* * Additions by AOL for specialized thread memory allocator. */ @@ -1027,6 +1030,7 @@ TclpFreeAllocCache( } #endif /* USE_THREAD_ALLOC */ + void * TclpThreadCreateKey(void) { diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 5636dc0..77f7547 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -103,6 +103,7 @@ static struct { double microsecsScale; /* Denominator scale between clock / microsecs */ } wideClick = {0, 0, 0.0}; + /* * Declarations for functions defined later in this file. */ -- cgit v0.12 From f2c803a9c4d1f954837acea25f227f842b465e4c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 18 May 2024 21:58:14 +0000 Subject: Update changes.md --- changes.md | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 62 insertions(+), 1 deletion(-) diff --git a/changes.md b/changes.md index 30404ce..2bedc57 100644 --- a/changes.md +++ b/changes.md @@ -1 +1,62 @@ -TODO \ No newline at end of file + +The source code for Tcl is managed by fossil. Tcl developers coordinate all +changes to the Tcl source code at + +> [Tcl Source Code](https://core.tcl-lang.org/tcl/timeline) + +Release Tcl 8.7b1 arises from the check-in with tag core-8.7-b1. + +Highlighted differences between Tcl 8.7 and Tcl 8.6 are summarized below, +with focus on changes important to programmers using the Tcl library and +writing Tcl scripts. + +## Internationalization of text + - Full Unicode range of codepoints + - New encodings: utf-16/utf-32/ucs-2(le|be), CESU-8, etc. + - `encoding` options -profile, -failindex manage encoding of I/O. + - `msgcat` supports custom locale search list + - `source` defaults to -encoding utf-8 + +## Zip filesystems and attached archives. + +## Unix notifiers available using epoll() or kqueue() + - relieves limits on file descriptors imposed by legacy select() + +## Notable incompatibilities + - No --disable-threads build option. Always thread-enabled. + - Windows platform needs Windows 7 or Windows Server 2008 R2 or later + +## New commands + - `array default`, `array for` + - `coroinject`, `coroprobe` + - `clock add weekdays` + - `dict getdefault` + - `file tempdir`, `file home`, `file tildeexpand` + - `info commandtype` + - `ledit` + - `lpop` + - `lremove` + - `lseq` + - `package files` + - `string insert`, `string is dict` + - `tcl::process` + - `*::build-info` + +## New command options + - `regsub ... -command ...` + - `lsearch ... -stride ...` + - `clock scan ... -validate ...` + - `socket ... -nodelay ... -keepalive ...` + - `vwait` controlled by several new options + +## Numbers + - 0dNNNN format to compel decimal interpretation. + - NN_NNN_NNN, underscores in numbers for optional readability + - Functions: isinf() isnan() isnormal() issubnormal() isunordered() + - `fpclassify` + - Function int() no longer truncates to word size + +## tcl::oo facilities + - private variable and methods + - `method -export`, `method -unexport` + -- cgit v0.12 From b8fc5c8d441fb25e5b33a5369072408bcea76ffd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 19 May 2024 22:23:02 +0000 Subject: Improve tcl::build-info implementation, adapted from dkf's result-helpers branch --- generic/tclBasic.c | 150 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 88 insertions(+), 62 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index ef13c5a..45072bd 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -664,82 +664,108 @@ buildInfoObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + const char *buildData = (const char *) clientData; + char buf[80]; + const char *arg, *p, *q; + Tcl_Size len; + int idx; + static const char *identifiers[] = { + "commit", "compiler", "patchlevel", "version", NULL + }; + enum Identifiers { + ID_COMMIT, ID_COMPILER, ID_PATCHLEVEL, ID_VERSION, ID_OTHER + }; + if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?option?"); return TCL_ERROR; + } else if (objc < 2) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(buildData, TCL_INDEX_NONE)); + return TCL_OK; } - if (objc == 2) { - Tcl_Size len; - const char *arg = TclGetStringFromObj(objv[1], &len); - if (len == 7 && !strcmp(arg, "version")) { - char buf[80]; - const char *p = strchr((char *)clientData, '.'); - if (p) { - const char *q = strchr(p+1, '.'); - const char *r = strchr(p+1, '+'); - p = (q < r) ? q : r; - } - if (p) { - memcpy(buf, (char *)clientData, p - (char *)clientData); - buf[p - (char *)clientData] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); - } - return TCL_OK; - } else if (len == 10 && !strcmp(arg, "patchlevel")) { - char buf[80]; - const char *p = strchr((char *)clientData, '+'); - if (p) { - memcpy(buf, (char *)clientData, p - (char *)clientData); - buf[p - (char *)clientData] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); + + /* + * Query for a specific piece of build info + */ + + if (Tcl_GetIndexFromObj(NULL, objv[1], identifiers, NULL, TCL_EXACT, + &idx) != TCL_OK) { + idx = ID_OTHER; + } + + switch (idx) { + case ID_PATCHLEVEL: + if ((p = strchr(buildData, '+')) != NULL) { + memcpy(buf, buildData, p - buildData); + buf[p - buildData] = '\0'; + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, TCL_INDEX_NONE)); + } + return TCL_OK; + case ID_VERSION: + if ((p = strchr(buildData, '.')) != NULL) { + const char *r = strchr(p++, '+'); + q = strchr(p, '.'); + p = (q < r) ? q : r; + } + if (p != NULL) { + memcpy(buf, buildData, p - buildData); + buf[p - buildData] = '\0'; + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, TCL_INDEX_NONE)); + } + return TCL_OK; + case ID_COMMIT: + if ((p = strchr(buildData, '+')) != NULL) { + if ((q = strchr(p++, '.')) != NULL) { + memcpy(buf, p, q - p); + buf[q - p] = '\0'; + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, TCL_INDEX_NONE)); + } else { + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, TCL_INDEX_NONE)); } - return TCL_OK; - } else if (len == 6 && !strcmp(arg, "commit")) { - const char *q, *p = strchr((char *)clientData, '+'); - if (p) { - if ((q = strchr(p, '.'))) { - char buf[80]; - memcpy(buf, p+1, q - p - 1); - buf[q - p - 1] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); + } + return TCL_OK; + case ID_COMPILER: + for (p = strchr(buildData, '.'); p++; p = strchr(p, '.')) { + /* + * Does the word begin with one of the standard prefixes? + */ + if (!strncmp(p, "clang-", 6) + || !strncmp(p, "gcc-", 4) + || !strncmp(p, "icc-", 4) + || !strncmp(p, "msvc-", 5)) { + if ((q = strchr(p, '.')) != NULL) { + memcpy(buf, p, q - p); + buf[q - p] = '\0'; + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, TCL_INDEX_NONE)); } else { - Tcl_AppendResult(interp, p+1, (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, TCL_INDEX_NONE)); } + return TCL_OK; } - return TCL_OK; - } else if (len == 8 && !strcmp(arg, "compiler")) { - const char *p = strchr((char *)clientData, '.'); - while (p) { - if (!strncmp(p+1, "clang-", 6) || !strncmp(p+1, "gcc-", 4) - || !strncmp(p+1, "icc-", 4) || !strncmp(p+1, "msvc-", 5)) { - const char *q = strchr(p+1, '.'); - if (q) { - char buf[16]; - memcpy(buf, p+1, q - p - 1); - buf[q - p - 1] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); - } else { - Tcl_AppendResult(interp, p+1, (char *)NULL); + } + break; + default: /* Boolean test for other identifiers' presence */ + arg = TclGetStringFromObj(objv[1], &len); + for (p = strchr(buildData, '.'); p++; p = strchr(p, '.')) { + if (!strncmp(p, arg, len) + && ((p[len] == '.') || (p[len] == '-') || (p[len] == '\0'))) { + if (p[len] == '-') { + p += len + 2; + q = strchr(p, '.'); + if (!q) { + q = p + strlen(p); } - return TCL_OK; + memcpy(buf, p, q - p); + buf[q - p] = '\0'; + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, TCL_INDEX_NONE)); + } else { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); } - p = strchr(p+1, '.'); - } - Tcl_AppendResult(interp, "0", (char *)NULL); - return TCL_OK; - } - const char *p = strchr((char *)clientData, '.'); - while (p) { - if (!strncmp(p+1, arg, len) && ((p[len+1] == '.') || (p[len+1] == '\0'))) { - Tcl_AppendResult(interp, "1", (char *)NULL); return TCL_OK; } - p = strchr(p+1, '.'); } - Tcl_AppendResult(interp, "0", (char *)NULL); - return TCL_OK; } - Tcl_AppendResult(interp, (char *)clientData, (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); return TCL_OK; } -- cgit v0.12 From 009e84db387d3379bff02435093917df19777a77 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 May 2024 09:32:30 +0000 Subject: Backport spacing-related changes from 9.0 --- generic/tclBasic.c | 1109 ++++++++++++++++++++++++++-------------------------- 1 file changed, 553 insertions(+), 556 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 45072bd..774ac80 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -63,7 +63,6 @@ /* actually there is no fallback to builtin fpclassify */ #endif /* !TCL_FPCLASSIFY_MODE */ - /* * Bug 7371b6270b: to check C call stack depth, prefer an approach which is * compatible with AddressSanitizer (ASan) use-after-return detection. @@ -85,17 +84,17 @@ void * TclGetCStackPtr(void) { #if defined( __GNUC__ ) || __has_builtin(__builtin_frame_address) - return __builtin_frame_address(0); + return __builtin_frame_address(0); #elif defined(_MSC_VER) && defined(HAVE_INTRIN_H) - return _AddressOfReturnAddress(); + return _AddressOfReturnAddress(); #else - ptrdiff_t unused = 0; - /* - * LLVM recommends using volatile: - * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31 - */ - ptrdiff_t *volatile stackLevel = &unused; - return (void *)stackLevel; + ptrdiff_t unused = 0; + /* + * LLVM recommends using volatile: + * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31 + */ + ptrdiff_t *volatile stackLevel = &unused; + return (void *)stackLevel; #endif } @@ -180,7 +179,7 @@ TCL_DECLARE_MUTEX(commandTypeLock); * Static functions in this file: */ -static Tcl_ObjCmdProc BadEnsembleSubcommand; +static Tcl_ObjCmdProc BadEnsembleSubcommand; static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr, const char *oldName, const char *newName, int flags); @@ -204,12 +203,12 @@ static Tcl_ObjCmdProc ExprDoubleFunc; static Tcl_ObjCmdProc ExprFloorFunc; static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; -static Tcl_ObjCmdProc ExprIsFiniteFunc; -static Tcl_ObjCmdProc ExprIsInfinityFunc; -static Tcl_ObjCmdProc ExprIsNaNFunc; -static Tcl_ObjCmdProc ExprIsNormalFunc; -static Tcl_ObjCmdProc ExprIsSubnormalFunc; -static Tcl_ObjCmdProc ExprIsUnorderedFunc; +static Tcl_ObjCmdProc ExprIsFiniteFunc; +static Tcl_ObjCmdProc ExprIsInfinityFunc; +static Tcl_ObjCmdProc ExprIsNaNFunc; +static Tcl_ObjCmdProc ExprIsNormalFunc; +static Tcl_ObjCmdProc ExprIsSubnormalFunc; +static Tcl_ObjCmdProc ExprIsUnorderedFunc; static Tcl_ObjCmdProc ExprMaxFunc; static Tcl_ObjCmdProc ExprMinFunc; static Tcl_ObjCmdProc ExprRandFunc; @@ -218,7 +217,7 @@ static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; -static Tcl_ObjCmdProc FloatClassifyObjCmd; +static Tcl_ObjCmdProc FloatClassifyObjCmd; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; @@ -268,11 +267,11 @@ MODULE_SCOPE const TclStubs tclStubs; * after particular kinds of [yield]. */ -#define CORO_ACTIVATE_YIELD NULL -#define CORO_ACTIVATE_YIELDM INT2PTR(1) +#define CORO_ACTIVATE_YIELD NULL +#define CORO_ACTIVATE_YIELDM INT2PTR(1) -#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) -#define COROUTINE_ARGUMENTS_ARBITRARY (-2) +#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) +#define COROUTINE_ARGUMENTS_ARBITRARY (-2) /* * The following structure define the commands in the Tcl core. @@ -286,9 +285,9 @@ typedef struct { int flags; /* Various flag bits, as defined below. */ } CmdInfo; -#define CMD_IS_SAFE 1 /* Whether this command is part of the set of - * commands present by default in a safe - * interpreter. */ +#define CMD_IS_SAFE 1 /* Whether this command is part of the set of + * commands present by default in a safe + * interpreter. */ /* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle * expansion for itself rather than needing the generic layer to take care of * it for it. Defined in tclInt.h. */ @@ -302,13 +301,13 @@ typedef struct { */ typedef struct { - const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for - * the end of the list of commands to hide. */ - const char *commandName; /* The name of the command within the - * ensemble. If this is NULL, we want to also - * make the overall command be hidden, an ugly - * hack because it is expected by security - * policies in the wild. */ + const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for + * the end of the list of commands to hide. */ + const char *commandName; /* The name of the command within the + * ensemble. If this is NULL, we want to also + * make the overall command be hidden, an ugly + * hack because it is expected by security + * policies in the wild. */ } UnsafeEnsembleInfo; /* @@ -329,8 +328,8 @@ static const CmdInfo builtInCmds[] = { {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, - {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, - {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, + {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, + {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE}, {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE}, @@ -338,14 +337,14 @@ static const CmdInfo builtInCmds[] = { {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, - {"fpclassify", FloatClassifyObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"fpclassify", FloatClassifyObjCmd, NULL, NULL, CMD_IS_SAFE}, {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, {"join", Tcl_JoinObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE}, {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE}, - {"ledit", Tcl_LeditObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"ledit", Tcl_LeditObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE}, {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE}, {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED}, @@ -353,12 +352,12 @@ static const CmdInfo builtInCmds[] = { {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, {"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, - {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, - {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, {"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE}, @@ -509,13 +508,13 @@ static const BuiltinFuncDef BuiltinFuncTable[] = { { "fmod", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) fmod}, { "hypot", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) hypot}, { "int", ExprIntFunc, NULL }, - { "isfinite", ExprIsFiniteFunc, NULL }, - { "isinf", ExprIsInfinityFunc, NULL }, - { "isnan", ExprIsNaNFunc, NULL }, - { "isnormal", ExprIsNormalFunc, NULL }, + { "isfinite", ExprIsFiniteFunc, NULL }, + { "isinf", ExprIsInfinityFunc, NULL }, + { "isnan", ExprIsNaNFunc, NULL }, + { "isnormal", ExprIsNormalFunc, NULL }, { "isqrt", ExprIsqrtFunc, NULL }, - { "issubnormal", ExprIsSubnormalFunc, NULL, }, - { "isunordered", ExprIsUnorderedFunc, NULL, }, + { "issubnormal", ExprIsSubnormalFunc, NULL, }, + { "isunordered", ExprIsUnorderedFunc, NULL, }, { "log", ExprUnaryFunc, log }, { "log10", ExprUnaryFunc, log10 }, { "max", ExprMaxFunc, NULL }, @@ -635,8 +634,8 @@ TclFinalizeEvaluation(void) Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_DeleteHashTable(&commandTypeTable); - commandTypeInit = 0; + Tcl_DeleteHashTable(&commandTypeTable); + commandTypeInit = 0; } Tcl_MutexUnlock(&commandTypeLock); } @@ -845,16 +844,16 @@ Tcl_CreateInterp(void) #undef TclObjInterpProc if (commandTypeInit == 0) { - TclRegisterCommandTypeName(TclObjInterpProc, "proc"); - TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); - TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclChildObjCmd, "interp"); - TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); - TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); - TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); - TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); - TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); + TclRegisterCommandTypeName(TclObjInterpProc, "proc"); + TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); + TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclChildObjCmd, "interp"); + TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); + TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); + TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); + TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); + TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); } /* @@ -979,7 +978,7 @@ Tcl_CreateInterp(void) iPtr->flags |= INTERP_DEBUG_FRAME; #else if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) { - iPtr->flags |= INTERP_DEBUG_FRAME; + iPtr->flags |= INTERP_DEBUG_FRAME; } #endif @@ -1136,9 +1135,9 @@ Tcl_CreateInterp(void) cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; - if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { - cmdPtr->flags |= CMD_COMPILES_EXPANDED; - } + if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { + cmdPtr->flags |= CMD_COMPILES_EXPANDED; + } cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = cmdInfoPtr->nreProc; @@ -1198,15 +1197,15 @@ Tcl_CreateInterp(void) /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, - "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, - TclNRAssembleObjCmd, NULL, NULL); + "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, + TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRInjectObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype", - CoroTypeObjCmd, NULL, NULL); + CoroTypeObjCmd, NULL, NULL); /* Export unsupported commands */ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); @@ -1214,7 +1213,6 @@ Tcl_CreateInterp(void) Tcl_Export(interp, nsPtr, "*", 1); } - #ifdef USE_DTRACE /* * Register the tcl::dtrace command. @@ -1235,7 +1233,7 @@ Tcl_CreateInterp(void) memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN); for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL; builtinFuncPtr++) { - strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); + strcpy(mathFuncName + MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, builtinFuncPtr->objCmdProc, (void *)builtinFuncPtr->fn, NULL); Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0); @@ -1380,10 +1378,10 @@ DeleteOpCmdClientData( * * TclRegisterCommandTypeName, TclGetCommandTypeName -- * - * Command type registration and lookup mechanism. Everything is keyed by - * the Tcl_ObjCmdProc for the command, and that is used as the *key* into - * the hash table that maps to constant strings that are names. (It is - * recommended that those names be ASCII.) + * Command type registration and lookup mechanism. Everything is keyed by + * the Tcl_ObjCmdProc for the command, and that is used as the *key* into + * the hash table that maps to constant strings that are names. (It is + * recommended that those names be ASCII.) * * --------------------------------------------------------------------- */ @@ -1397,21 +1395,21 @@ TclRegisterCommandTypeName( Tcl_MutexLock(&commandTypeLock); if (commandTypeInit == 0) { - Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); - commandTypeInit = 1; + Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); + commandTypeInit = 1; } if (nameStr != NULL) { - int isNew; + int isNew; - hPtr = Tcl_CreateHashEntry(&commandTypeTable, - implementationProc, &isNew); - Tcl_SetHashValue(hPtr, (void *) nameStr); + hPtr = Tcl_CreateHashEntry(&commandTypeTable, + implementationProc, &isNew); + Tcl_SetHashValue(hPtr, (void *) nameStr); } else { - hPtr = Tcl_FindHashEntry(&commandTypeTable, - implementationProc); - if (hPtr != NULL) { - Tcl_DeleteHashEntry(hPtr); - } + hPtr = Tcl_FindHashEntry(&commandTypeTable, + implementationProc); + if (hPtr != NULL) { + Tcl_DeleteHashEntry(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); } @@ -1425,15 +1423,15 @@ TclGetCommandTypeName( const char *name = "native"; if (procPtr == NULL) { - procPtr = cmdPtr->nreProc; + procPtr = cmdPtr->nreProc; } Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); - if (hPtr && Tcl_GetHashValue(hPtr)) { - name = (const char *) Tcl_GetHashValue(hPtr); - } + if (hPtr && Tcl_GetHashValue(hPtr)) { + name = (const char *) Tcl_GetHashValue(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); @@ -1473,41 +1471,41 @@ TclHideUnsafeCommands( } for (unsafePtr = unsafeEnsembleCommands; - unsafePtr->ensembleNsName; unsafePtr++) { - if (unsafePtr->commandName) { - /* - * Hide an ensemble subcommand. - */ - - Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - - if (TclRenameCommand(interp, TclGetString(cmdName), - "___tmp") != TCL_OK - || Tcl_HideCommand(interp, "___tmp", - TclGetString(hideName)) != TCL_OK) { - Tcl_Panic("problem making '%s %s' safe: %s", - unsafePtr->ensembleNsName, unsafePtr->commandName, - Tcl_GetStringResult(interp)); - } - Tcl_CreateObjCommand(interp, TclGetString(cmdName), - BadEnsembleSubcommand, (void *)unsafePtr, NULL); - TclDecrRefCount(cmdName); - TclDecrRefCount(hideName); - } else { - /* - * Hide an ensemble main command (for compatibility). - */ - - if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, - unsafePtr->ensembleNsName) != TCL_OK) { - Tcl_Panic("problem making '%s' safe: %s", - unsafePtr->ensembleNsName, - Tcl_GetStringResult(interp)); - } - } + unsafePtr->ensembleNsName; unsafePtr++) { + if (unsafePtr->commandName) { + /* + * Hide an ensemble subcommand. + */ + + Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + + if (TclRenameCommand(interp, TclGetString(cmdName), + "___tmp") != TCL_OK + || Tcl_HideCommand(interp, "___tmp", + TclGetString(hideName)) != TCL_OK) { + Tcl_Panic("problem making '%s %s' safe: %s", + unsafePtr->ensembleNsName, unsafePtr->commandName, + Tcl_GetStringResult(interp)); + } + Tcl_CreateObjCommand(interp, TclGetString(cmdName), + BadEnsembleSubcommand, (void *)unsafePtr, NULL); + TclDecrRefCount(cmdName); + TclDecrRefCount(hideName); + } else { + /* + * Hide an ensemble main command (for compatibility). + */ + + if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, + unsafePtr->ensembleNsName) != TCL_OK) { + Tcl_Panic("problem making '%s' safe: %s", + unsafePtr->ensembleNsName, + Tcl_GetStringResult(interp)); + } + } } return TCL_OK; @@ -1541,8 +1539,8 @@ BadEnsembleSubcommand( const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData; Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "not allowed to invoke subcommand %s of %s", - infoPtr->commandName, infoPtr->ensembleNsName)); + "not allowed to invoke subcommand %s of %s", + infoPtr->commandName, infoPtr->ensembleNsName)); Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL); return TCL_ERROR; } @@ -1573,7 +1571,7 @@ Tcl_CallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; @@ -1621,7 +1619,7 @@ Tcl_DontCallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTablePtr; @@ -1669,7 +1667,7 @@ Tcl_SetAssocData( const char *name, /* Name for association. */ Tcl_InterpDeleteProc *proc, /* Proc to call when interpreter is about to * be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; AssocData *dPtr; @@ -2249,7 +2247,7 @@ Tcl_HideCommand( Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" " token (rename)", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); return TCL_ERROR; } @@ -2272,9 +2270,9 @@ Tcl_HideCommand( if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only hide global namespace commands (use rename then hide)", - TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); + "can only hide global namespace commands (use rename then hide)", + TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } @@ -2298,9 +2296,9 @@ Tcl_HideCommand( hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "hidden command named \"%s\" already exists", - hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); + "hidden command named \"%s\" already exists", + hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); return TCL_ERROR; } @@ -2402,9 +2400,9 @@ Tcl_ExposeCommand( if (strstr(cmdName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot expose to a namespace (use expose to toplevel, then rename)", - TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); + "cannot expose to a namespace (use expose to toplevel, then rename)", + TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } @@ -2419,9 +2417,9 @@ Tcl_ExposeCommand( } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown hidden command \"%s\"", hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", - hiddenCmdToken, (char *)NULL); + "unknown hidden command \"%s\"", hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", + hiddenCmdToken, (char *)NULL); return TCL_ERROR; } cmdPtr = (Command *)Tcl_GetHashValue(hPtr); @@ -2458,8 +2456,8 @@ Tcl_ExposeCommand( hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "exposed command \"%s\" already exists", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); + "exposed command \"%s\" already exists", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); return TCL_ERROR; } @@ -2556,7 +2554,7 @@ Tcl_CreateCommand( * specified namespace; otherwise it is put in * the global namespace. */ Tcl_CmdProc *proc, /* Function to associate with cmdName. */ - void *clientData, /* Arbitrary value passed to string proc. */ + void *clientData, /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ @@ -2587,26 +2585,26 @@ Tcl_CreateCommand( */ while (1) { - /* - * Determine where the command should reside. If its name contains - * namespace qualifiers, we put it in the specified namespace; + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; * otherwise, we always put it in the global namespace. - */ + */ - if (strstr(cmdName, "::") != NULL) { + if (strstr(cmdName, "::") != NULL) { Namespace *dummy1, *dummy2; TclGetNamespaceForQualName(interp, cmdName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if ((nsPtr == NULL) || (tail == NULL)) { - return (Tcl_Command) NULL; + return (Tcl_Command) NULL; } - } else { + } else { nsPtr = iPtr->globalNsPtr; tail = cmdName; - } + } - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); if (isNew || deleted) { /* @@ -2617,8 +2615,8 @@ Tcl_CreateCommand( } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ cmdPtr = (Command *)Tcl_GetHashValue(hPtr); @@ -2754,12 +2752,11 @@ Tcl_CreateObjCommand( * the global namespace. */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ - Tcl_CmdDeleteProc *deleteProc + Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ -) { Interp *iPtr = (Interp *) interp; Namespace *nsPtr; @@ -2800,11 +2797,11 @@ Tcl_Command TclCreateObjCommandInNs( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace - * components. */ - Tcl_Namespace *namesp, /* The namespace to create the command in */ + * components. */ + Tcl_Namespace *namesp, /* The namespace to create the command in */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when @@ -2836,8 +2833,8 @@ TclCreateObjCommandInNs( } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ cmdPtr = (Command *)Tcl_GetHashValue(hPtr); @@ -2871,14 +2868,14 @@ TclCreateObjCommandInNs( } /* - * Make sure namespace doesn't get deallocated. - */ + * Make sure namespace doesn't get deallocated. + */ cmdPtr->nsPtr->refCount++; Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); nsPtr = (Namespace *) TclEnsureNamespace(interp, - (Tcl_Namespace *) cmdPtr->nsPtr); + (Tcl_Namespace *) cmdPtr->nsPtr); TclNsDecrRefCount(cmdPtr->nsPtr); if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) { @@ -3136,10 +3133,10 @@ TclRenameCommand( cmdPtr = (Command *) cmd; if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't %s \"%s\": command doesn't exist", - ((newName == NULL)||(*newName == '\0'))? "delete":"rename", + "can't %s \"%s\": command doesn't exist", + ((newName == NULL) || (*newName == '\0')) ? "delete" : "rename", oldName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); return TCL_ERROR; } @@ -3169,16 +3166,16 @@ TclRenameCommand( if ((newNsPtr == NULL) || (newTail == NULL)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": bad command name", newName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); + "can't rename to \"%s\": bad command name", newName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); result = TCL_ERROR; goto done; } if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": command already exists", newName)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", - "TARGET_EXISTS", (char *)NULL); + "can't rename to \"%s\": command already exists", newName)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", + "TARGET_EXISTS", (char *)NULL); result = TCL_ERROR; goto done; } @@ -4293,8 +4290,8 @@ Tcl_GetMathFuncInfo( */ if (cmdPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown math function \"%s\"", name)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown math function \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, (char *)NULL); *numArgsPtr = -1; *argTypesPtr = NULL; @@ -4519,7 +4516,7 @@ Tcl_Canceled( */ if (!TclCanceled(iPtr)) { - return TCL_OK; + return TCL_OK; } /* @@ -4540,7 +4537,7 @@ Tcl_Canceled( */ if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) { - return TCL_OK; + return TCL_OK; } /* @@ -4549,34 +4546,34 @@ Tcl_Canceled( */ if (flags & TCL_LEAVE_ERR_MSG) { - const char *id, *message = NULL; - Tcl_Size length; + const char *id, *message = NULL; + Tcl_Size length; - /* - * Setup errorCode variables so that we can differentiate between - * being canceled and unwound. - */ + /* + * Setup errorCode variables so that we can differentiate between + * being canceled and unwound. + */ - if (iPtr->asyncCancelMsg != NULL) { - message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); - } else { - length = 0; - } + if (iPtr->asyncCancelMsg != NULL) { + message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); + } else { + length = 0; + } - if (iPtr->flags & TCL_CANCEL_UNWIND) { - id = "IUNWIND"; - if (length == 0) { - message = "eval unwound"; - } - } else { - id = "ICANCEL"; - if (length == 0) { - message = "eval canceled"; - } - } + if (iPtr->flags & TCL_CANCEL_UNWIND) { + id = "IUNWIND"; + if (length == 0) { + message = "eval unwound"; + } + } else { + id = "ICANCEL"; + if (length == 0) { + message = "eval canceled"; + } + } - Tcl_SetObjResult(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); } /* @@ -4615,7 +4612,7 @@ Tcl_CancelEval( * script. */ Tcl_Obj *resultObjPtr, /* The script cancellation error message or * NULL for a default error message. */ - void *clientData, /* Passed to CancelEvalProc. */ + void *clientData, /* Passed to CancelEvalProc. */ int flags) /* Collection of OR-ed bits that control * the cancellation of the script. Only * TCL_CANCEL_UNWIND is currently @@ -4658,7 +4655,7 @@ Tcl_CancelEval( if (resultObjPtr != NULL) { result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); - cancelInfo->result = (char *)ckrealloc(cancelInfo->result,cancelInfo->length); + cancelInfo->result = (char *)ckrealloc(cancelInfo->result, cancelInfo->length); memcpy(cancelInfo->result, result, cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { @@ -4761,7 +4758,7 @@ TclNREvalObjv( */ if (iPtr->deferredCallbacks) { - iPtr->deferredCallbacks = NULL; + iPtr->deferredCallbacks = NULL; } else { TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); } @@ -4849,13 +4846,13 @@ EvalObjvCore( assert(cmdPtr == NULL); if (preCmdPtr) { /* - * Caller gave it to us. - */ + * Caller gave it to us. + */ if (!(preCmdPtr->flags & CMD_DEAD)) { /* - * So long as it exists, use it. - */ + * So long as it exists, use it. + */ cmdPtr = preCmdPtr; } else if (flags & TCL_EVAL_NORESOLVE) { @@ -4880,7 +4877,7 @@ EvalObjvCore( if (enterTracesDone || iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { Tcl_Obj *commandPtr = TclGetSourceFromFrame( - flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, + flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, objc, objv); Tcl_IncrRefCount(commandPtr); @@ -4923,7 +4920,7 @@ EvalObjvCore( cmdPtr->refCount++; TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc), - commandPtr, cmdPtr, objv); + commandPtr, cmdPtr, objv); } TclNRAddCallback(interp, Dispatch, @@ -5010,8 +5007,8 @@ TclNRRunCallbacks( */ while (TOP_CB(interp) != rootPtr) { - NRE_callback *callbackPtr = TOP_CB(interp); - Tcl_NRPostProc *procPtr = callbackPtr->procPtr; + NRE_callback *callbackPtr = TOP_CB(interp); + Tcl_NRPostProc *procPtr = callbackPtr->procPtr; TOP_CB(interp) = callbackPtr->nextPtr; result = procPtr(callbackPtr->data, interp, result); @@ -5031,9 +5028,9 @@ NRCommand( iPtr->numLevels--; - /* - * If there is a tailcall, schedule it next - */ + /* + * If there is a tailcall, schedule it next + */ if (data[1] && (data[1] != INT2PTR(1))) { listPtr = (Tcl_Obj *)data[1]; @@ -5248,7 +5245,7 @@ TEOV_NotFound( newObjv[i] = handlerObjv[i]; Tcl_IncrRefCount(newObjv[i]); } - memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc); + memcpy(newObjv + handlerObjc, objv, sizeof(Tcl_Obj *) * objc); /* * Look up and invoke the handler (by recursive call to this function). If @@ -5263,9 +5260,9 @@ TEOV_NotFound( cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr); if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid command name \"%s\"", TclGetString(objv[0]))); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", - TclGetString(objv[0]), (char *)NULL); + "invalid command name \"%s\"", TclGetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", + TclGetString(objv[0]), (char *)NULL); /* * Release any resources we locked and allocated during the handler @@ -5464,7 +5461,7 @@ Tcl_EvalTokensStandard( * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - Tcl_Size count) /* Number of tokens to consider at tokenPtr. + Tcl_Size count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, @@ -5569,7 +5566,7 @@ TclEvalEx( * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ Tcl_Size line, /* The line the script starts on. */ - Tcl_Size *clNextOuter, /* Information about an outer context for */ + Tcl_Size *clNextOuter, /* Information about an outer context for */ const char *outerScript) /* continuation line data. This is set only in * TclSubstTokens(), to properly handle * [...]-nested commands. The 'outerScript' @@ -5607,13 +5604,12 @@ TclEvalEx( * properly if an error occurs. */ Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); - Tcl_Obj **stackObjArray = (Tcl_Obj **) - TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); + Tcl_Obj **stackObjArray = (Tcl_Obj **)TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int)); Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size)); /* TIP #280 Structures for tracking of command * locations. */ - Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible + Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible * continuation lines. Initialized only if the * caller gave us a table of locations to * track, via scriptCLLocPtr. It always refers @@ -5746,9 +5742,11 @@ TclEvalEx( */ if (numWords > minObjs) { - expand = (int *)ckalloc(numWords * sizeof(int)); - objvSpace = (Tcl_Obj **)ckalloc(numWords * sizeof(Tcl_Obj *)); - lineSpace = (Tcl_Size *)ckalloc(numWords * sizeof(Tcl_Size)); + expand = (int *) ckalloc(numWords * sizeof(int)); + objvSpace = (Tcl_Obj **) + ckalloc(numWords * sizeof(Tcl_Obj *)); + lineSpace = (Tcl_Size *) + ckalloc(numWords * sizeof(Tcl_Size)); } expandRequested = 0; objv = objvSpace; @@ -5757,7 +5755,7 @@ TclEvalEx( iPtr->cmdFramePtr = eeFramePtr->nextPtr; for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr; objectsUsed < numWords; - objectsUsed++, tokenPtr += tokenPtr->numComponents+1) { + objectsUsed++, tokenPtr += tokenPtr->numComponents + 1) { /* * TIP #280. Track lines to current word. Save the information * on a per-word basis, signaling dynamic words as needed. @@ -5778,7 +5776,7 @@ TclEvalEx( iPtr->evalFlags |= TCL_EVAL_FILE; } - code = TclSubstTokens(interp, tokenPtr+1, + code = TclSubstTokens(interp, tokenPtr + 1, tokenPtr->numComponents, NULL, wordLine, wordCLNext, outerScript); @@ -5833,9 +5831,10 @@ TclEvalEx( Tcl_Size objIdx = objectsNeeded - 1; if ((numWords > minObjs) || (objectsNeeded > minObjs)) { - objv = objvSpace = - (Tcl_Obj **)ckalloc(objectsNeeded * sizeof(Tcl_Obj *)); - lines = lineSpace = (Tcl_Size *)ckalloc(objectsNeeded * sizeof(Tcl_Size)); + objv = objvSpace = (Tcl_Obj **) + ckalloc(objectsNeeded * sizeof(Tcl_Obj *)); + lines = lineSpace = (Tcl_Size *) + ckalloc(objectsNeeded * sizeof(Tcl_Size)); } objectsUsed = 0; @@ -5859,7 +5858,7 @@ TclEvalEx( objectsUsed++; } } - objv += objIdx+1; + objv += objIdx + 1; if (copy != stackObjArray) { ckfree(copy); @@ -6205,8 +6204,7 @@ TclArgumentRelease( for (i = 1; i < objc; i++) { CFWord *cfwPtr; - Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]); if (!hPtr) { continue; @@ -6257,8 +6255,7 @@ TclArgumentBCEnter( ECL *ePtr; CFWordBC *lastPtr = NULL; Interp *iPtr = (Interp *) interp; - Tcl_HashEntry *hePtr = - Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); + Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); if (!hePtr) { return; @@ -6280,7 +6277,7 @@ TclArgumentBCEnter( */ if (ePtr->nline != objc) { - return; + return; } /* @@ -6298,7 +6295,7 @@ TclArgumentBCEnter( if (ePtr->line[word] >= 0) { int isNew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, - objv[word], &isNew); + objv[word], &isNew); CFWordBC *cfwPtr = (CFWordBC *)ckalloc(sizeof(CFWordBC)); cfwPtr->framePtr = cfPtr; @@ -6565,7 +6562,7 @@ 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 + 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 @@ -6578,7 +6575,7 @@ 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 + 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 @@ -6597,7 +6594,7 @@ 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 + 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 @@ -6682,7 +6679,7 @@ TclNREvalObjEx( } TclMarkTailcall(interp); - TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, + TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); TclListObjGetElements(NULL, listPtr, &objc, &objv); @@ -6703,9 +6700,9 @@ TclNREvalObjEx( * iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ - if (TclInterpReady(interp) != TCL_OK) { - return TCL_ERROR; - } + if (TclInterpReady(interp) != TCL_OK) { + return TCL_ERROR; + } if (flags & TCL_EVAL_GLOBAL) { savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; @@ -6715,7 +6712,7 @@ TclNREvalObjEx( TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr, objPtr, INT2PTR(allowExceptions), NULL); - return TclNRExecuteByteCode(interp, codePtr); + return TclNRExecuteByteCode(interp, codePtr); } { @@ -7012,7 +7009,7 @@ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ long *ptr) /* Where to store long result. */ { Tcl_Obj *resultPtr; @@ -7025,7 +7022,7 @@ Tcl_ExprLongObj( return TCL_ERROR; } - if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) { + if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type) != TCL_OK) { return TCL_ERROR; } @@ -7059,7 +7056,7 @@ int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ double *ptr) /* Where to store double result. */ { Tcl_Obj *resultPtr; @@ -7095,7 +7092,7 @@ int Tcl_ExprBooleanObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ int *ptr) /* Where to store 0/1 result. */ { Tcl_Obj *resultPtr; @@ -7135,7 +7132,7 @@ int TclObjInvokeNamespace( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ Tcl_Namespace *nsPtr, /* The namespace to use. */ @@ -7179,7 +7176,7 @@ int TclObjInvoke( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ int flags) /* Combination of flags controlling the call: @@ -7191,7 +7188,7 @@ TclObjInvoke( } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal argument vector", TCL_INDEX_NONE)); + "illegal argument vector", TCL_INDEX_NONE)); return TCL_ERROR; } if ((flags & TCL_INVOKE_HIDDEN) == 0) { @@ -7220,9 +7217,9 @@ TclNRInvoke( } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid hidden command name \"%s\"", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, - (char *)NULL); + "invalid hidden command name \"%s\"", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, + (char *)NULL); return TCL_ERROR; } cmdPtr = (Command *)Tcl_GetHashValue(hPtr); @@ -7864,7 +7861,7 @@ ExprIsqrtFunc( negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "square root of negative argument", TCL_INDEX_NONE)); + "square root of negative argument", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", (char *)NULL); return TCL_ERROR; @@ -8292,20 +8289,20 @@ ExprMaxMinFunc( } res = objv[1]; for (i = 1; i < objc; i++) { - if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { - return TCL_ERROR; - } - if (type == TCL_NUMBER_NAN) { - /* - * Get the error message for NaN. - */ - - Tcl_GetDoubleFromObj(interp, objv[i], &d); - return TCL_ERROR; - } - if (TclCompareTwoNumbers(objv[i], res) == op) { - res = objv[i]; - } + if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type == TCL_NUMBER_NAN) { + /* + * Get the error message for NaN. + */ + + Tcl_GetDoubleFromObj(interp, objv[i], &d); + return TCL_ERROR; + } + if (TclCompareTwoNumbers(objv[i], res) == op) { + res = objv[i]; + } } Tcl_SetObjResult(interp, res); @@ -8361,7 +8358,7 @@ ExprRandFunc( * take into consideration the thread this interp is running in. */ - iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread())*4093U; + iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread()) * 4093U; /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. @@ -8558,8 +8555,8 @@ ExprSrandFunc( * This page contains the functions that implement all of the built-in * math functions for classifying IEEE doubles. * - * These have to be a little bit careful while Tcl_GetDoubleFromObj() - * rejects NaN values, which these functions *explicitly* accept. + * These have to be a little bit careful while Tcl_GetDoubleFromObj() + * rejects NaN values, which these functions *explicitly* accept. * * Results: * Each function returns TCL_OK if it succeeds and pushes an Tcl object @@ -8593,16 +8590,16 @@ ClassifyDouble( * Hence we define those here. */ #ifndef FP_NAN -# define FP_NAN 1 /* Value is NaN */ -# define FP_INFINITE 2 /* Value is an infinity */ -# define FP_ZERO 3 /* Value is a zero */ -# define FP_NORMAL 4 /* Value is a normal float */ -# define FP_SUBNORMAL 5 /* Value has lost accuracy */ +# define FP_NAN 1 /* Value is NaN */ +# define FP_INFINITE 2 /* Value is an infinity */ +# define FP_ZERO 3 /* Value is a zero */ +# define FP_NORMAL 4 /* Value is a normal float */ +# define FP_SUBNORMAL 5 /* Value has lost accuracy */ #endif /* !FP_NAN */ #if TCL_FPCLASSIFY_MODE == 3 return __builtin_fpclassify( - FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); + FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); #elif TCL_FPCLASSIFY_MODE == 2 /* * We assume this hack is only needed on little-endian systems. @@ -8612,27 +8609,27 @@ ClassifyDouble( */ union { - double d; /* Interpret as double */ - struct { - unsigned int low; /* Lower 32 bits */ - unsigned int high; /* Upper 32 bits */ - } w; /* Interpret as unsigned integer words */ - } doubleMeaning; /* So we can look at the representation of a - * double directly. Platform (i.e., processor) - * specific; this is for x86 (and most other - * little-endian processors, but those are - * untested). */ + double d; /* Interpret as double */ + struct { + unsigned int low; /* Lower 32 bits */ + unsigned int high; /* Upper 32 bits */ + } w; /* Interpret as unsigned integer words */ + } doubleMeaning; /* So we can look at the representation of a + * double directly. Platform (i.e., processor) + * specific; this is for x86 (and most other + * little-endian processors, but those are + * untested). */ unsigned int exponent, mantissaLow, mantissaHigh; - /* The pieces extracted from the double. */ - int zeroMantissa; /* Was the mantissa zero? That's special. */ + /* The pieces extracted from the double. */ + int zeroMantissa; /* Was the mantissa zero? That's special. */ /* * Shifts and masks to use with the doubleMeaning variable above. */ -#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ -#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ -#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ +#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ +#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ +#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ /* * Extract the exponent (11 bits) and mantissa (52 bits). Note that we @@ -8651,43 +8648,43 @@ ClassifyDouble( switch (exponent) { case 0: - /* - * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. - */ + /* + * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. + */ - return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; + return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; case EXPONENT_MASK: - /* - * When the exponent is all ones, it's an INF or a NAN. - */ + /* + * When the exponent is all ones, it's an INF or a NAN. + */ - return zeroMantissa ? FP_INFINITE : FP_NAN; + return zeroMantissa ? FP_INFINITE : FP_NAN; default: - /* - * Everything else is a NORMAL double precision float. - */ + /* + * Everything else is a NORMAL double precision float. + */ - return FP_NORMAL; + return FP_NORMAL; } #elif TCL_FPCLASSIFY_MODE == 1 switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: - return FP_ZERO; + return FP_ZERO; case _FPCLASS_NN: case _FPCLASS_PN: - return FP_NORMAL; + return FP_NORMAL; case _FPCLASS_ND: case _FPCLASS_PD: - return FP_SUBNORMAL; + return FP_SUBNORMAL; case _FPCLASS_NINF: case _FPCLASS_PINF: - return FP_INFINITE; + return FP_INFINITE; default: - Tcl_Panic("result of _fpclass() outside documented range!"); + Tcl_Panic("result of _fpclass() outside documented range!"); case _FPCLASS_QNAN: case _FPCLASS_SNAN: - return FP_NAN; + return FP_NAN; } #else /* TCL_FPCLASSIFY_MODE not in (0..3) */ #error "unknown or unexpected TCL_FPCLASSIFY_MODE" @@ -8713,14 +8710,14 @@ ExprIsFiniteFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - type = ClassifyDouble(d); - result = (type != FP_INFINITE && type != FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + type = ClassifyDouble(d); + result = (type != FP_INFINITE && type != FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8744,13 +8741,13 @@ ExprIsInfinityFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_INFINITE); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_INFINITE); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8774,13 +8771,13 @@ ExprIsNaNFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8804,13 +8801,13 @@ ExprIsNormalFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8834,13 +8831,13 @@ ExprIsSubnormalFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_SUBNORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_SUBNORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8864,23 +8861,23 @@ ExprIsUnorderedFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result = 1; + result = 1; } else { - d = *((const double *) ptr); - result = (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result = (ClassifyDouble(d) == FP_NAN); } if (Tcl_GetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result |= 1; + result |= 1; } else { - d = *((const double *) ptr); - result |= (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result |= (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); @@ -8901,39 +8898,39 @@ FloatClassifyObjCmd( int type; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); + Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - goto gotNaN; + goto gotNaN; } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } switch (ClassifyDouble(d)) { case FP_INFINITE: - TclNewLiteralStringObj(objPtr, "infinite"); - break; + TclNewLiteralStringObj(objPtr, "infinite"); + break; case FP_NAN: gotNaN: - TclNewLiteralStringObj(objPtr, "nan"); - break; + TclNewLiteralStringObj(objPtr, "nan"); + break; case FP_NORMAL: - TclNewLiteralStringObj(objPtr, "normal"); - break; + TclNewLiteralStringObj(objPtr, "normal"); + break; case FP_SUBNORMAL: - TclNewLiteralStringObj(objPtr, "subnormal"); - break; + TclNewLiteralStringObj(objPtr, "subnormal"); + break; case FP_ZERO: - TclNewLiteralStringObj(objPtr, "zero"); - break; + TclNewLiteralStringObj(objPtr, "zero"); + break; default: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to classify number: %f", d)); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to classify number: %f", d)); + return TCL_ERROR; } Tcl_SetObjResult(interp, objPtr); return TCL_OK; @@ -8966,10 +8963,10 @@ MathFuncWrongNumArgs( const char *name = TclGetString(objv[0]); const char *tail = name + strlen(name); - while (tail > name+1) { + while (tail > name + 1) { tail--; if (*tail == ':' && tail[-1] == ':') { - name = tail+1; + name = tail + 1; break; } } @@ -9198,7 +9195,7 @@ Tcl_NRCreateCommand( * calls. */ Tcl_ObjCmdProc *nreProc, /* Object-based function to associate with * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when @@ -9206,7 +9203,7 @@ Tcl_NRCreateCommand( { Command *cmdPtr = (Command *) Tcl_CreateObjCommand(interp, cmdName, proc, clientData, - deleteProc); + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; @@ -9223,8 +9220,8 @@ TclNRCreateCommandInNs( Tcl_CmdDeleteProc *deleteProc) { Command *cmdPtr = (Command *) - TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, - deleteProc); + TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; @@ -9247,7 +9244,7 @@ int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - Tcl_Size objc, /* Number of words in command. */ + Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the @@ -9288,14 +9285,14 @@ Tcl_NRCmdSwap( * will execute. There are functions whose purpose is to help define the * precise spot: * TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution - * should continue right here + * should continue right here * TclSkipTailcall: if the NEXT command to be pushed tailcalls, execution - * should continue after the CURRENT command is fully returned ("skip - * the next command: we are redirecting to it, tailcalls should run - * after WE return") + * should continue after the CURRENT command is fully returned ("skip + * the next command: we are redirecting to it, tailcalls should run + * after WE return") * TclPushTailcallPoint: the search for a tailcalling spot cannot traverse - * this point. This is special for OO, as some of the oo constructs - * that behave like commands may not push an NRCommand callback. + * this point. This is special for OO, as some of the oo constructs + * that behave like commands may not push an NRCommand callback. */ void @@ -9306,8 +9303,8 @@ TclMarkTailcall( if (iPtr->deferredCallbacks == NULL) { TclNRAddCallback(interp, NRCommand, NULL, NULL, - NULL, NULL); - iPtr->deferredCallbacks = TOP_CB(interp); + NULL, NULL); + iPtr->deferredCallbacks = TOP_CB(interp); } } @@ -9354,12 +9351,12 @@ TclSetTailcall( NRE_callback *runPtr; for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { - if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { - break; - } + if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { + break; + } } if (!runPtr) { - Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); + Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); } runPtr->data[1] = listPtr; } @@ -9395,9 +9392,9 @@ TclNRTailcallObjCmd( } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tailcall can only be called from a proc, lambda or method", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "tailcall can only be called from a proc, lambda or method", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); return TCL_ERROR; } @@ -9407,8 +9404,8 @@ TclNRTailcallObjCmd( */ if (iPtr->varFramePtr->tailcallPtr) { - Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); - iPtr->varFramePtr->tailcallPtr = NULL; + Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); + iPtr->varFramePtr->tailcallPtr = NULL; } /* @@ -9418,19 +9415,19 @@ TclNRTailcallObjCmd( */ if (objc > 1) { - Tcl_Obj *listPtr, *nsObjPtr; - Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; + Tcl_Obj *listPtr, *nsObjPtr; + Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; - /* - * The tailcall data is in a Tcl list: the first element is the - * namespace, the rest the command to be tailcalled. - */ + /* + * The tailcall data is in a Tcl list: the first element is the + * namespace, the rest the command to be tailcalled. + */ - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); - listPtr = Tcl_NewListObj(objc, objv); + nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); + listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); - iPtr->varFramePtr->tailcallPtr = listPtr; + iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } @@ -9465,13 +9462,13 @@ TclNRTailcallEval( } if (result != TCL_OK) { - /* - * Tailcall execution was preempted, eg by an intervening catch or by - * a now-gone namespace: cleanup and return. - */ + /* + * Tailcall execution was preempted, eg by an intervening catch or by + * a now-gone namespace: cleanup and return. + */ Tcl_DecrRefCount(listPtr); - return result; + return result; } /* @@ -9558,7 +9555,7 @@ TclNRYieldObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yield can only be called in a coroutine", TCL_INDEX_NONE)); + "yield can only be called in a coroutine", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } @@ -9569,7 +9566,7 @@ TclNRYieldObjCmd( NRE_ASSERT(!COR_IS_SUSPENDED(corPtr)); TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - clientData, NULL, NULL); + clientData, NULL, NULL); return TCL_OK; } @@ -9591,17 +9588,17 @@ TclNRYieldToObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto can only be called in a coroutine", TCL_INDEX_NONE)); + "yieldto can only be called in a coroutine", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } if (((Namespace *) nsPtr)->flags & NS_DYING) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto called in deleted namespace", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", (char *)NULL); - return TCL_ERROR; + return TCL_ERROR; } /* @@ -9766,14 +9763,14 @@ NRCoroutineExitCallback( * * TclNRCoroutineActivateCallback -- * - * This is the workhorse for coroutines: it implements both yield and - * resume. + * This is the workhorse for coroutines: it implements both yield and + * resume. * - * It is important that both be implemented in the same callback: the - * detection of the impossibility to suspend due to a busy C-stack relies - * on the precise position of a local variable in the stack. We do not - * want the compiler to play tricks on us, either by moving things around - * or inlining. + * It is important that both be implemented in the same callback: the + * detection of the impossibility to suspend due to a busy C-stack relies + * on the precise position of a local variable in the stack. We do not + * want the compiler to play tricks on us, either by moving things around + * or inlining. * *---------------------------------------------------------------------- */ @@ -9788,35 +9785,35 @@ TclNRCoroutineActivateCallback( void *stackLevel = TclGetCStackPtr(); if (!corPtr->stackLevel) { - /* - * -- Coroutine is suspended -- - * Push the callback to restore the caller's context on yield or - * return. - */ - - TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); - - /* - * Record the stackLevel at which the resume is happening, then swap - * the interp's environment to make it suitable to run this coroutine. - */ - - corPtr->stackLevel = stackLevel; - Tcl_Size numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = iPtr->numLevels; - - SAVE_CONTEXT(corPtr->caller); - corPtr->callerEEPtr = iPtr->execEnvPtr; - RESTORE_CONTEXT(corPtr->running); - iPtr->execEnvPtr = corPtr->eePtr; - iPtr->numLevels += numLevels; + /* + * -- Coroutine is suspended -- + * Push the callback to restore the caller's context on yield or + * return. + */ + + TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, + NULL, NULL, NULL); + + /* + * Record the stackLevel at which the resume is happening, then swap + * the interp's environment to make it suitable to run this coroutine. + */ + + corPtr->stackLevel = stackLevel; + Tcl_Size numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = iPtr->numLevels; + + SAVE_CONTEXT(corPtr->caller); + corPtr->callerEEPtr = iPtr->execEnvPtr; + RESTORE_CONTEXT(corPtr->running); + iPtr->execEnvPtr = corPtr->eePtr; + iPtr->numLevels += numLevels; } else { - /* - * Coroutine is active: yield - */ + /* + * Coroutine is active: yield + */ - if (corPtr->stackLevel != stackLevel) { + if (corPtr->stackLevel != stackLevel) { NRE_callback *runPtr; iPtr->execEnvPtr = corPtr->callerEEPtr; @@ -9833,30 +9830,30 @@ TclNRCoroutineActivateCallback( iPtr->execEnvPtr = corPtr->eePtr; - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot yield: C stack busy", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", - (char *)NULL); - return TCL_ERROR; - } + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot yield: C stack busy", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", + (char *)NULL); + return TCL_ERROR; + } - void *type = data[1]; - if (type == CORO_ACTIVATE_YIELD) { - corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; - } else if (type == CORO_ACTIVATE_YIELDM) { - corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; - } else { - Tcl_Panic("Yield received an option which is not implemented"); - } + void *type = data[1]; + if (type == CORO_ACTIVATE_YIELD) { + corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; + } else if (type == CORO_ACTIVATE_YIELDM) { + corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; + } else { + Tcl_Panic("Yield received an option which is not implemented"); + } corPtr->yieldPtr = NULL; - corPtr->stackLevel = NULL; + corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return TCL_OK; @@ -9922,11 +9919,11 @@ CoroTypeObjCmd( cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only get coroutine type of a coroutine", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objv[1]), (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only get coroutine type of a coroutine", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objv[1]), (char *)NULL); + return TCL_ERROR; } /* @@ -9936,8 +9933,8 @@ CoroTypeObjCmd( corPtr = (CoroutineData *)cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("active", TCL_INDEX_NONE)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("active", TCL_INDEX_NONE)); + return TCL_OK; } /* @@ -9947,16 +9944,16 @@ CoroTypeObjCmd( switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", TCL_INDEX_NONE)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", TCL_INDEX_NONE)); + return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", TCL_INDEX_NONE)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", TCL_INDEX_NONE)); + return TCL_OK; default: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown coroutine type", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unknown coroutine type", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); + return TCL_ERROR; } } @@ -9983,10 +9980,10 @@ GetCoroutineFromObj( Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objPtr), (char *)NULL); - return NULL; + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objPtr), (char *)NULL); + return NULL; } return (CoroutineData *)cmdPtr->objClientData; } @@ -10011,15 +10008,15 @@ TclNRCoroInjectObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -10030,7 +10027,7 @@ TclNRCoroInjectObjCmd( ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; @@ -10056,16 +10053,16 @@ TclNRCoroProbeObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a probe command into a coroutine"); + "can only inject a probe command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a probe command into a suspended coroutine", - TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a probe command into a suspended coroutine", + TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -10076,7 +10073,7 @@ TclNRCoroProbeObjCmd( ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); iPtr->execEnvPtr = savedEEPtr; /* @@ -10087,7 +10084,7 @@ TclNRCoroProbeObjCmd( */ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); /* * Record the stackLevel at which the resume is happening, then swap @@ -10115,18 +10112,18 @@ TclNRCoroProbeObjCmd( * * InjectHandler, InjectHandlerPostProc -- * - * Part of the implementation of [coroinject] and [coroprobe]. These are - * run inside the context of the coroutine being injected/probed into. + * Part of the implementation of [coroinject] and [coroprobe]. These are + * run inside the context of the coroutine being injected/probed into. * - * InjectHandler runs a script (possibly adding arguments) in the context - * of the coroutine. The script is specified as a one-shot list (with - * reference count equal to 1) in data[1]. This function also arranges - * for InjectHandlerPostProc to be the part that runs after the script - * completes. + * InjectHandler runs a script (possibly adding arguments) in the context + * of the coroutine. The script is specified as a one-shot list (with + * reference count equal to 1) in data[1]. This function also arranges + * for InjectHandlerPostProc to be the part that runs after the script + * completes. * - * InjectHandlerPostProc cleans up after InjectHandler (deleting the - * list) and, for the [coroprobe] command *only*, yields back to the - * caller context (i.e., where [coroprobe] was run). + * InjectHandlerPostProc cleans up after InjectHandler (deleting the + * list) and, for the [coroprobe] command *only*, yields back to the + * caller context (i.e., where [coroprobe] was run). *s *---------------------------------------------------------------------- */ @@ -10173,7 +10170,7 @@ InjectHandler( Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr, - INT2PTR(nargs), isProbe); + INT2PTR(nargs), isProbe); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } @@ -10203,16 +10200,16 @@ InjectHandlerPostCall( */ if (isProbe) { - if (result == TCL_ERROR) { - Tcl_AddErrorInfo(interp, - "\n (injected coroutine probe command)"); - } - corPtr->nargs = nargs; - corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + if (result == TCL_ERROR) { + Tcl_AddErrorInfo(interp, + "\n (injected coroutine probe command)"); + } + corPtr->nargs = nargs; + corPtr->stackLevel = NULL; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return result; } @@ -10222,7 +10219,7 @@ InjectHandlerPostCall( * * NRInjectObjCmd -- * - * Implementation of [::tcl::unsupported::inject] command. + * Implementation of [::tcl::unsupported::inject] command. * *---------------------------------------------------------------------- */ @@ -10248,15 +10245,15 @@ NRInjectObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -10265,8 +10262,8 @@ NRInjectObjCmd( */ iPtr->execEnvPtr = corPtr->eePtr; - TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2), - NULL, NULL, NULL); + TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc - 2, objv + 2), + NULL, NULL, NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; @@ -10283,8 +10280,8 @@ TclNRInterpCoroutine( if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "coroutine \"%s\" is already running", - TclGetString(objv[0]))); + "coroutine \"%s\" is already running", + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", (char *)NULL); return TCL_ERROR; } @@ -10297,31 +10294,31 @@ TclNRInterpCoroutine( switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - if (objc == 2) { - Tcl_SetObjResult(interp, objv[1]); - } else if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); - return TCL_ERROR; - } - break; + if (objc == 2) { + Tcl_SetObjResult(interp, objv[1]); + } else if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); + return TCL_ERROR; + } + break; default: - if (corPtr->nargs + 1 != objc) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong coro nargs; how did we get here? " - "not implemented!", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); - return TCL_ERROR; - } - /* fallthrough */ + if (corPtr->nargs + 1 != objc) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong coro nargs; how did we get here? " + "not implemented!", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); + return TCL_ERROR; + } + /* fallthrough */ case COROUTINE_ARGUMENTS_ARBITRARY: - if (objc > 1) { - Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); - } - break; + if (objc > 1) { + Tcl_SetObjResult(interp, Tcl_NewListObj(objc - 1, objv + 1)); + } + break; } TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } @@ -10330,8 +10327,8 @@ TclNRInterpCoroutine( * * TclNRCoroutineObjCmd -- * - * Implementation of [coroutine] command; see documentation for - * description of what this does. + * Implementation of [coroutine] command; see documentation for + * description of what this does. * *---------------------------------------------------------------------- */ @@ -10361,16 +10358,16 @@ TclNRCoroutineObjCmd( if (nsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": unknown namespace", - procName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); + "can't create procedure \"%s\": unknown namespace", + procName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); return TCL_ERROR; } if (simpleName == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": bad procedure name", - procName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); + "can't create procedure \"%s\": bad procedure name", + procName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); return TCL_ERROR; } @@ -10462,7 +10459,7 @@ TclNRCoroutineObjCmd( */ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } -- cgit v0.12 From 9386d6db5d27ea5850cb70f01c53fa0578922f31 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 May 2024 09:54:44 +0000 Subject: Improve readability from some typecasting trickery. Backported from 9.0 (thanks, dkf!) --- generic/tclBasic.c | 43 ++++++++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 19 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 774ac80..f84c277 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -485,48 +485,52 @@ static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = { * Math functions. All are safe. */ +typedef double (BuiltinUnaryFunc)(double x); +typedef double (BuiltinBinaryFunc)(double x, double y); +#define BINARY_TYPECAST(fn) \ + (BuiltinUnaryFunc *)(void *)(BuiltinBinaryFunc *) fn typedef struct { const char *name; /* Name of the function. The full name is * "::tcl::mathfunc::". */ Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */ - double (*fn)(double x); /* Real function pointer */ + BuiltinUnaryFunc *fn; /* Real function pointer */ } BuiltinFuncDef; static const BuiltinFuncDef BuiltinFuncTable[] = { { "abs", ExprAbsFunc, NULL }, { "acos", ExprUnaryFunc, acos }, { "asin", ExprUnaryFunc, asin }, { "atan", ExprUnaryFunc, atan }, - { "atan2", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) atan2}, + { "atan2", ExprBinaryFunc, BINARY_TYPECAST(atan2) }, { "bool", ExprBoolFunc, NULL }, { "ceil", ExprCeilFunc, NULL }, - { "cos", ExprUnaryFunc, cos }, + { "cos", ExprUnaryFunc, cos }, { "cosh", ExprUnaryFunc, cosh }, { "double", ExprDoubleFunc, NULL }, { "entier", ExprIntFunc, NULL }, - { "exp", ExprUnaryFunc, exp }, + { "exp", ExprUnaryFunc, exp }, { "floor", ExprFloorFunc, NULL }, - { "fmod", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) fmod}, - { "hypot", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) hypot}, + { "fmod", ExprBinaryFunc, BINARY_TYPECAST(fmod) }, + { "hypot", ExprBinaryFunc, BINARY_TYPECAST(hypot) }, { "int", ExprIntFunc, NULL }, { "isfinite", ExprIsFiniteFunc, NULL }, { "isinf", ExprIsInfinityFunc, NULL }, - { "isnan", ExprIsNaNFunc, NULL }, + { "isnan", ExprIsNaNFunc, NULL }, { "isnormal", ExprIsNormalFunc, NULL }, { "isqrt", ExprIsqrtFunc, NULL }, - { "issubnormal", ExprIsSubnormalFunc, NULL, }, - { "isunordered", ExprIsUnorderedFunc, NULL, }, - { "log", ExprUnaryFunc, log }, + { "issubnormal", ExprIsSubnormalFunc, NULL, }, + { "isunordered", ExprIsUnorderedFunc, NULL, }, + { "log", ExprUnaryFunc, log }, { "log10", ExprUnaryFunc, log10 }, { "max", ExprMaxFunc, NULL }, { "min", ExprMinFunc, NULL }, - { "pow", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) pow}, + { "pow", ExprBinaryFunc, BINARY_TYPECAST(pow) }, { "rand", ExprRandFunc, NULL }, { "round", ExprRoundFunc, NULL }, - { "sin", ExprUnaryFunc, sin }, + { "sin", ExprUnaryFunc, sin }, { "sinh", ExprUnaryFunc, sinh }, { "sqrt", ExprSqrtFunc, NULL }, { "srand", ExprSrandFunc, NULL }, - { "tan", ExprUnaryFunc, tan }, + { "tan", ExprUnaryFunc, tan }, { "tanh", ExprUnaryFunc, tanh }, { "wide", ExprWideFunc, NULL }, { NULL, NULL, NULL } @@ -824,7 +828,7 @@ Tcl_CreateInterp(void) * the result is a binary incompatible with the 'standard' build of * Tcl: All extensions using Tcl_StatBuf need to be recompiled in * the same way. Therefore, this is not officially supported. - * In stead, it is recommended to use Win64 or Tcl 9.0 (not released yet) + * In stead, it is recommended to use Win64 or Tcl 9.0 */ if ((offsetof(Tcl_StatBuf,st_atime) != 32) || (offsetof(Tcl_StatBuf,st_ctime) != 40)) { @@ -7921,7 +7925,7 @@ ExprSqrtFunc( static int ExprUnaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes one double argument and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the @@ -7931,7 +7935,7 @@ ExprUnaryFunc( { int code; double d; - double (*func)(double) = (double (*)(double)) clientData; + BuiltinUnaryFunc *func = (BuiltinUnaryFunc *) clientData; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); @@ -7985,7 +7989,7 @@ CheckDoubleResult( static int ExprBinaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes two double arguments and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the @@ -7995,7 +7999,7 @@ ExprBinaryFunc( { int code; double d1, d2; - double (*func)(double, double) = (double (*)(double, double)) clientData; + BuiltinBinaryFunc *func = (BuiltinBinaryFunc *)clientData; if (objc != 3) { MathFuncWrongNumArgs(interp, 3, objc, objv); @@ -8071,7 +8075,8 @@ ExprAbsFunc( Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); return TCL_OK; } - bytes++; numBytes--; + bytes++; + numBytes--; } } goto unChanged; -- cgit v0.12 From 5058546a065aac81835d429609e485f177795c8a Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 20 May 2024 13:38:38 +0000 Subject: Test case to demonstrate [7842f33a5c] --- tests/oo.test | 34 +++++++++++++++++++++++++++++++--- 1 file changed, 31 insertions(+), 3 deletions(-) diff --git a/tests/oo.test b/tests/oo.test index 8e2cb5f..ecd39fd 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -4274,8 +4274,6 @@ test oo-35.5 {Bug 1a56550e96: introspectors must traverse mixin links correctly} } -cleanup { base destroy } -result {{c d e} {c d e}} - - test oo-35.6 { Bug : teardown of an object that is a class that is an instance of itself } -setup { @@ -4297,7 +4295,37 @@ test oo-35.6 { } -cleanup { rename obj {} } -result done - +test oo-35.7 {Bug 7842f33a5c: destructor cascading} -setup { + oo::class create base + oo::class create RpcClient { + superclass base + method write name { + lappend ::result "RpcClient -> $name" + } + method create_bug {} { + MkObjectRpc create cfg [self] 111 + } + } + oo::class create MkObjectRpc { + superclass base + variable hdl + constructor {rpcHdl mqHdl} { + set hdl $mqHdl + oo::objdefine [self] forward rpc $rpcHdl + } + destructor { + my rpc write otto-$hdl + } + } + set ::result {} +} -body { + set FH [RpcClient new] + $FH create_bug + $FH destroy + join $result \n +} -cleanup { + base destroy +} -result {} cleanupTests -- cgit v0.12 From 8c51083a72744d7f010fbe2fa45b2df5730b622d Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 20 May 2024 15:06:52 +0000 Subject: Add some machinery for easier testing --- win/Makefile.in | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/win/Makefile.in b/win/Makefile.in index a325ac3..1a8bd2d 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -206,6 +206,7 @@ MKDIR = mkdir -p SHELL = @SHELL@ RM = rm -f COPY = cp +GDB = gdb CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \ -I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" -DTCL_TOMMATH \ @@ -814,7 +815,16 @@ shell: binaries # This target can be used to run tclsh inside either gdb or insight gdb: binaries @echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run - gdb ./$(TCLSH) --command=gdb.run + $(GDB) ./$(TCLSH) --command=gdb.run + rm gdb.run + +shquotequote = $(subst ',\",$(subst ",\",$(1))) +gdb-test: tcltest + @printf '%s ' 'set env TCL_LIBRARY=$(LIBRARY_DIR)' > gdb.run + @printf '\n' >>gdb.run + @printf '%s ' set args $(ROOT_DIR_NATIVE)/tests/all.tcl \ + $(call shquotequote,$(TESTFLAGS)) -singleproc 1 >> gdb.run + $(GDB) ${TEST_EXE_FILE} --command=gdb.run rm gdb.run depend: -- cgit v0.12 From 090a10bc43c3eb76b987c94d3d65674ba4b40ec9 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 20 May 2024 15:09:01 +0000 Subject: Fix for [7842f33a5c]: Stereotype call chains were ending up bogus in some situations --- generic/tclOOCall.c | 58 +++++++++++++++++++++++++++++++++++----- tests/oo.test | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 128 insertions(+), 7 deletions(-) diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index aefd921..bfff4e9 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -891,15 +891,28 @@ InitCallChain( Object *oPtr, int flags) { + /* + * Note that it's possible to end up with a NULL oPtr->selfCls here if + * there is a call into stereotypical object after it has finished running + * its destructor phase. Such things can't be cached for a long time so the + * epoch can be bogus. [Bug 7842f33a5c] + */ + callPtr->flags = flags & (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING); if (oPtr->flags & USE_CLASS_CACHE) { - oPtr = oPtr->selfCls->thisPtr; + oPtr = (oPtr->selfCls ? oPtr->selfCls->thisPtr : NULL); callPtr->flags |= USE_CLASS_CACHE; } - callPtr->epoch = oPtr->fPtr->epoch; - callPtr->objectCreationEpoch = oPtr->creationEpoch; - callPtr->objectEpoch = oPtr->epoch; + if (oPtr) { + callPtr->epoch = oPtr->fPtr->epoch; + callPtr->objectCreationEpoch = oPtr->creationEpoch; + callPtr->objectEpoch = oPtr->epoch; + } else { + callPtr->epoch = 0; + callPtr->objectCreationEpoch = 0; + callPtr->objectEpoch = 0; + } callPtr->refCount = 1; callPtr->numChain = 0; callPtr->chain = callPtr->staticChain; @@ -930,6 +943,13 @@ IsStillValid( int mask) { if ((oPtr->flags & USE_CLASS_CACHE)) { + /* + * If the object is in a weird state (due to stereotype tricks) then + * just declare the cache invalid. [Bug 7842f33a5c] + */ + if (!oPtr->selfCls) { + return 0; + } oPtr = oPtr->selfCls->thisPtr; flags |= USE_CLASS_CACHE; } @@ -1020,8 +1040,16 @@ TclOOGetCallContext( FreeMethodNameRep(cacheInThisObj); } - if (oPtr->flags & USE_CLASS_CACHE) { - if (oPtr->selfCls->classChainCache != NULL) { + /* + * Note that it's possible to end up with a NULL oPtr->selfCls here if + * there is a call into stereotypical object after it has finished + * running its destructor phase. It's quite a tangle, but at that + * point, we simply can't get stereotypes from the cache. + * [Bug 7842f33a5c] + */ + + if (oPtr->flags & USE_CLASS_CACHE && oPtr->selfCls) { + if (oPtr->selfCls->classChainCache) { hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache, (char *) methodNameObj); } else { @@ -1226,6 +1254,17 @@ TclOOGetStereotypeCallChain( Object obj; /* + * Note that it's possible to end up with a NULL clsPtr here if there is + * a call into stereotypical object after it has finished running its + * destructor phase. It's quite a tangle, but at that point, we simply + * can't get stereotypes. [Bug 7842f33a5c] + */ + + if (clsPtr == NULL) { + return NULL; + } + + /* * Synthesize a temporary stereotypical object so that we can use existing * machinery to produce the stereotypical call chain. */ @@ -1448,9 +1487,16 @@ AddSimpleClassChainToCallContext( * * Note that mixins must be processed before the main class hierarchy. * [Bug 1998221] + * + * Note also that it's possible to end up with a null classPtr here if + * there is a call into stereotypical object after it has finished running + * its destructor phase. [Bug 7842f33a5c] */ tailRecurse: + if (classPtr == NULL) { + return; + } FOREACH(superPtr, classPtr->mixins) { AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, filterDecl); diff --git a/tests/oo.test b/tests/oo.test index ecd39fd..366f4d3 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -4295,7 +4295,7 @@ test oo-35.6 { } -cleanup { rename obj {} } -result done -test oo-35.7 {Bug 7842f33a5c: destructor cascading} -setup { +test oo-35.7.1 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { oo::class create base oo::class create RpcClient { superclass base @@ -4326,6 +4326,81 @@ test oo-35.7 {Bug 7842f33a5c: destructor cascading} -setup { } -cleanup { base destroy } -result {} +test oo-35.7.2 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { + oo::class create base + oo::class create RpcClient { + superclass base + method write name { + lappend ::result "RpcClient -> $name" + } + method create_bug {} { + MkObjectRpc create cfg [self] 111 + } + destructor { + lappend ::result "Destroyed" + } + } + oo::class create MkObjectRpc { + superclass base + variable hdl + constructor {rpcHdl mqHdl} { + set hdl $mqHdl + oo::objdefine [self] forward rpc $rpcHdl + } + destructor { + my rpc write otto-$hdl + } + } + set ::result {} +} -body { + set FH [RpcClient new] + $FH create_bug + $FH destroy + join $result \n +} -cleanup { + base destroy +} -result {Destroyed} +test oo-35.7.3 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { + oo::class create base + oo::class create RpcClient { + superclass base + variable interiorObjects + method write name { + lappend ::result "RpcClient -> $name" + } + method create_bug {} { + set obj [MkObjectRpc create cfg [self] 111] + lappend interiorObjects $obj + return $obj + } + destructor { + lappend ::result "Destroyed" + # Explicit destroy of interior objects + foreach obj $interiorObjects { + $obj destroy + } + } + } + oo::class create MkObjectRpc { + superclass base + variable hdl + constructor {rpcHdl mqHdl} { + set hdl $mqHdl + oo::objdefine [self] forward rpc $rpcHdl + } + destructor { + my rpc write otto-$hdl + } + } + set ::result {} +} -body { + set FH [RpcClient new] + $FH create_bug + $FH destroy + join $result \n +} -cleanup { + base destroy +} -result "Destroyed\nRpcClient -> otto-111" cleanupTests -- cgit v0.12 From ffc0d4a87016ca2f10ac6332358d20c735cdaf82 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 20 May 2024 18:07:31 +0000 Subject: Replay the churn commits --- generic/tcl.h | 182 +++--- generic/tclAlloc.c | 31 +- generic/tclBasic.c | 1402 ++++++++++++++++++++++--------------------- generic/tclBinary.c | 1 - generic/tclCkalloc.c | 39 +- generic/tclClock.c | 5 - generic/tclCmdAH.c | 15 +- generic/tclCmdIL.c | 1 - generic/tclCompCmds.c | 4 - generic/tclCompCmdsSZ.c | 1 - generic/tclCompExpr.c | 2 +- generic/tclCompile.h | 352 +++++------ generic/tclDisassemble.c | 19 +- generic/tclEncoding.c | 24 +- generic/tclEnv.c | 9 +- generic/tclEvent.c | 2 - generic/tclExecute.c | 424 ++++++------- generic/tclHash.c | 4 +- generic/tclIO.c | 27 +- generic/tclIO.h | 4 +- generic/tclIOCmd.c | 1 - generic/tclIORChan.c | 57 +- generic/tclIORTrans.c | 28 +- generic/tclIOSock.c | 8 +- generic/tclIOUtil.c | 63 +- generic/tclInt.h | 843 +++++++++++++------------- generic/tclInterp.c | 5 +- generic/tclListObj.c | 5 +- generic/tclLoad.c | 31 +- generic/tclNamesp.c | 5 +- generic/tclOOCall.c | 1 - generic/tclObj.c | 2 - generic/tclPanic.c | 1 - generic/tclParse.c | 2 +- generic/tclPathObj.c | 2 - generic/tclProc.c | 61 +- generic/tclProcess.c | 4 +- generic/tclRegexp.c | 25 +- generic/tclStrToD.c | 3 - generic/tclStringObj.c | 2 - generic/tclStringRep.h | 1 - generic/tclStubLibTbl.c | 10 +- generic/tclThread.c | 1 - generic/tclTomMathStubLib.c | 1 - generic/tclTrace.c | 1 - generic/tclUtf.c | 2 - generic/tclUtil.c | 8 +- generic/tclZipfs.c | 27 +- macosx/tclMacOSXNotify.c | 1 - unix/tclKqueueNotfy.c | 3 +- unix/tclLoadNext.c | 1 - unix/tclLoadOSF.c | 1 - unix/tclUnixInit.c | 1 - win/tclWinChan.c | 5 +- win/tclWinConsole.c | 5 +- win/tclWinFCmd.c | 1 - win/tclWinInt.h | 4 +- win/tclWinPipe.c | 1 - win/tclWinPort.h | 3 - win/tclWinSerial.c | 2 - win/tclWinThrd.c | 24 +- win/tclWinTime.c | 1 - 62 files changed, 1888 insertions(+), 1913 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index e40e8a9..947e4a7 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -48,15 +48,15 @@ extern "C" { */ #if !defined(TCL_MAJOR_VERSION) -# define TCL_MAJOR_VERSION 9 +# define TCL_MAJOR_VERSION 9 #endif #if TCL_MAJOR_VERSION == 9 -# define TCL_MINOR_VERSION 0 -# define TCL_RELEASE_LEVEL TCL_BETA_RELEASE -# define TCL_RELEASE_SERIAL 2 +# define TCL_MINOR_VERSION 0 +# define TCL_RELEASE_LEVEL TCL_BETA_RELEASE +# define TCL_RELEASE_SERIAL 2 -# define TCL_VERSION "9.0" -# define TCL_PATCH_LEVEL "9.0b2" +# define TCL_VERSION "9.0" +# define TCL_PATCH_LEVEL "9.0b2" #endif /* TCL_MAJOR_VERSION */ #if defined(RC_INVOKED) @@ -90,7 +90,8 @@ extern "C" { * Special macro to define mutexes. */ -#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name; +#define TCL_DECLARE_MUTEX(name) \ + static Tcl_Mutex name; /* * Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and @@ -464,9 +465,9 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData); typedef struct Tcl_RegExpIndices { #if TCL_MAJOR_VERSION > 8 - Tcl_Size start; /* Character offset of first character in + Tcl_Size start; /* Character offset of first character in * match. */ - Tcl_Size end; /* Character offset of first character after + Tcl_Size end; /* Character offset of first character after * the match. */ #else long start; @@ -475,11 +476,11 @@ typedef struct Tcl_RegExpIndices { } Tcl_RegExpIndices; typedef struct Tcl_RegExpInfo { - Tcl_Size nsubs; /* Number of subexpressions in the compiled + Tcl_Size nsubs; /* Number of subexpressions in the compiled * expression. */ Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ #if TCL_MAJOR_VERSION > 8 - Tcl_Size extendStart; /* The offset at which a subsequent match + Tcl_Size extendStart; /* The offset at which a subsequent match * might begin. */ #else long extendStart; @@ -615,28 +616,25 @@ typedef void (Tcl_ServiceModeHookProc) (int mode); typedef void *(Tcl_InitNotifierProc) (void); typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); - + /* Abstract List functions */ -typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr); -typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size index, struct Tcl_Obj** elemObj); -typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size fromIdx, Tcl_Size toIdx, - struct Tcl_Obj **newObjPtr); -typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - struct Tcl_Obj **newObjPtr); -typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size *objcptr, struct Tcl_Obj ***objvptr); -typedef struct Tcl_Obj* (Tcl_ObjTypeSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size indexCount, - struct Tcl_Obj *const indexArray[], - struct Tcl_Obj *valueObj); -typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj, - Tcl_Size first, Tcl_Size numToDelete, - Tcl_Size numToInsert, - struct Tcl_Obj *const insertObjs[]); -typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj, - struct Tcl_Obj *listObj, int *boolResult); +typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr); +typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size index, struct Tcl_Obj** elemObj); +typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size fromIdx, Tcl_Size toIdx, struct Tcl_Obj **newObjPtr); +typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, + struct Tcl_Obj *listPtr, struct Tcl_Obj **newObjPtr); +typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, + struct Tcl_Obj *listPtr, Tcl_Size *objcptr, struct Tcl_Obj ***objvptr); +typedef struct Tcl_Obj *(Tcl_ObjTypeSetElement) (Tcl_Interp *interp, + struct Tcl_Obj *listPtr, Tcl_Size indexCount, + struct Tcl_Obj *const indexArray[], struct Tcl_Obj *valueObj); +typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, + struct Tcl_Obj *listObj, Tcl_Size first, Tcl_Size numToDelete, + Tcl_Size numToInsert, struct Tcl_Obj *const insertObjs[]); +typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, + struct Tcl_Obj *valueObj, struct Tcl_Obj *listObj, int *boolResult); #ifndef TCL_NO_DEPRECATED # define Tcl_PackageInitProc Tcl_LibraryInitProc @@ -670,33 +668,36 @@ typedef struct Tcl_ObjType { size_t version; /* List emulation functions - ObjType Version 1 */ - Tcl_ObjTypeLengthProc *lengthProc; /* Return the [llength] of the - ** AbstractList */ - Tcl_ObjTypeIndexProc *indexProc; /* Return a value (Tcl_Obj) for - ** [lindex $al $index] */ - Tcl_ObjTypeSliceProc *sliceProc; /* Return an AbstractList for - ** [lrange $al $start $end] */ - Tcl_ObjTypeReverseProc *reverseProc; /* Return an AbstractList for - ** [lreverse $al] */ - Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in - ** the list */ - Tcl_ObjTypeSetElement *setElementProc; /* Replace the element at the indicie - ** with the given valueObj. */ - Tcl_ObjTypeReplaceProc *replaceProc; /* Replace subset with subset */ - Tcl_ObjTypeInOperatorProc *inOperProc; /* "in" and "ni" expr list - ** operation Determine if the given - ** string value matches an element in - ** the list */ + Tcl_ObjTypeLengthProc *lengthProc; + /* Return the [llength] of the AbstractList */ + Tcl_ObjTypeIndexProc *indexProc; + /* Return a value (Tcl_Obj) at a given index */ + Tcl_ObjTypeSliceProc *sliceProc; + /* Return an AbstractList for + * [lrange $al $start $end] */ + Tcl_ObjTypeReverseProc *reverseProc; + /* Return an AbstractList for [lreverse $al] */ + Tcl_ObjTypeGetElements *getElementsProc; + /* Return an objv[] of all elements in the list */ + Tcl_ObjTypeSetElement *setElementProc; + /* Replace the element at the indicies with the + * given valueObj. */ + Tcl_ObjTypeReplaceProc *replaceProc; + /* Replace sublist with another sublist */ + Tcl_ObjTypeInOperatorProc *inOperProc; + /* "in" and "ni" expr list operation. + * Determine if the given string value matches + * an element in the list. */ #endif } Tcl_ObjType; #if TCL_MAJOR_VERSION > 8 # define TCL_OBJTYPE_V0 0, \ - 0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */ + 0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */ # define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \ - a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */ + a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */ # define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType), \ - a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */ + a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */ #else # define TCL_OBJTYPE_V0 /* just empty */ #endif @@ -749,9 +750,9 @@ typedef struct Tcl_Obj { * corresponds to the type of the object's * internal rep. NULL indicates the object has * no internal rep (has no type). */ - Tcl_ObjInternalRep internalRep; /* The internal representation: */ + Tcl_ObjInternalRep internalRep; + /* The internal representation: */ } Tcl_Obj; - /* *---------------------------------------------------------------------------- @@ -767,7 +768,7 @@ typedef struct Tcl_Namespace { * is an synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - void *clientData; /* Arbitrary value associated with this + void *clientData; /* Arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Function invoked when deleting the @@ -841,11 +842,11 @@ typedef struct { Tcl_ObjCmdProc *objProc; /* Command's object-based function. */ void *objClientData; /* ClientData for object proc. */ Tcl_CmdProc *proc; /* Command's string-based function. */ - void *clientData; /* ClientData for string proc. */ + void *clientData; /* ClientData for string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Function to call when command is * deleted. */ - void *deleteData; /* Value to pass to deleteProc (usually the + void *deleteData; /* Value to pass to deleteProc (usually the * same as clientData). */ Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this * command. Note that Tcl_SetCmdInfo will not @@ -964,7 +965,7 @@ typedef struct Tcl_DString { * TCL_CANCEL_UNWIND: Magical Tcl_CancelEval mode that causes the * stack for the script in progress to be * completely unwound. - * TCL_EVAL_NOERR: Do no exception reporting at all, just return + * TCL_EVAL_NOERR: Do no exception reporting at all, just return * as the caller will report. */ @@ -1077,7 +1078,7 @@ struct Tcl_HashEntry { * or NULL for end of chain. */ Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ size_t hash; /* Hash value. */ - void *clientData; /* Application stores something here with + void *clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ char *oneWordValue; /* One-word value for key. */ @@ -1173,11 +1174,11 @@ struct Tcl_HashTable { Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - Tcl_Size numBuckets; /* Total number of buckets allocated at + Tcl_Size numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ - Tcl_Size numEntries; /* Total number of entries present in + Tcl_Size numEntries; /* Total number of entries present in * table. */ - Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be + Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ #if TCL_MAJOR_VERSION > 8 size_t mask; /* Mask value used in hashing function. */ @@ -1186,7 +1187,7 @@ struct Tcl_HashTable { * Designed to use high-order bits of * randomized keys. */ #if TCL_MAJOR_VERSION < 9 - int mask; /* Mask value used in hashing function. */ + int mask; /* Mask value used in hashing function. */ #endif int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, @@ -1776,8 +1777,8 @@ typedef struct Tcl_Token { int type; /* Type of token, such as TCL_TOKEN_WORD; see * below for valid types. */ const char *start; /* First character in token. */ - Tcl_Size size; /* Number of bytes in token. */ - Tcl_Size numComponents; /* If this token is composed of other tokens, + Tcl_Size size; /* Number of bytes in token. */ + Tcl_Size numComponents; /* If this token is composed of other tokens, * this field tells how many of them there are * (including components of components, etc.). * The component tokens immediately follow @@ -1891,13 +1892,13 @@ typedef struct Tcl_Token { typedef struct Tcl_Parse { const char *commentStart; /* Pointer to # that begins the first of one * or more comments preceding the command. */ - Tcl_Size commentSize; /* Number of bytes in comments (up through + Tcl_Size commentSize; /* Number of bytes in comments (up through * newline character that terminates the last * comment). If there were no comments, this * field is 0. */ const char *commandStart; /* First character in first word of * command. */ - Tcl_Size commandSize; /* Number of bytes in command, including first + Tcl_Size commandSize; /* Number of bytes in command, including first * character of first word, up through the * terminating newline, close bracket, or * semicolon. */ @@ -1967,7 +1968,7 @@ typedef struct Tcl_EncodingType { Tcl_FreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ - void *clientData; /* Arbitrary value associated with encoding + void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ Tcl_Size nullSize; /* Number of zero bytes that signify * end-of-string in this encoding. This number @@ -2173,7 +2174,7 @@ typedef struct { * depends on type.*/ const char *helpStr; /* Documentation message describing this * option. */ - void *clientData; /* Word to pass to function callbacks. */ + void *clientData; /* Word to pass to function callbacks. */ } Tcl_ArgvInfo; /* @@ -2293,9 +2294,9 @@ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, */ #if TCL_MAJOR_VERSION > 8 -# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) +# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) #else -# define TCL_STUB_MAGIC ((int) 0xFCA3BACF) +# define TCL_STUB_MAGIC ((int) 0xFCA3BACF) #endif /* @@ -2312,7 +2313,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char * TclInitStubTable(const char *version); void * TclStubCall(void *arg); #if defined(_WIN32) - TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...); + TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...); #else # define Tcl_ConsolePanic ((Tcl_PanicProc *)NULL) #endif @@ -2360,7 +2361,8 @@ void * TclStubCall(void *arg); * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ -#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ +#define Tcl_Main(argc, argv, proc) \ + Tcl_MainEx(argc, argv, proc, \ ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp()))) EXTERN TCL_NORETURN void Tcl_MainEx(Tcl_Size argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); @@ -2379,9 +2381,9 @@ EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp, #ifndef TCL_NO_DEPRECATED # define Tcl_StaticPackage Tcl_StaticLibrary #endif -EXTERN Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc); +EXTERN Tcl_ExitProc * Tcl_SetExitProc(Tcl_ExitProc *proc); #ifdef _WIN32 -EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv); +EXTERN const char * TclZipfs_AppHook(int *argc, wchar_t ***argv); #else EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); #endif @@ -2501,7 +2503,11 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); # define Tcl_BounceRefCount(objPtr) \ TclBounceRefCount(objPtr, __FILE__, __LINE__) -static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line) +static inline void +TclBounceRefCount( + Tcl_Obj* objPtr, + const char* fn, + int line) { if (objPtr) { if ((objPtr)->refCount == 0) { @@ -2519,11 +2525,11 @@ static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line) */ # undef Tcl_DecrRefCount # define Tcl_DecrRefCount(objPtr) \ - do { \ - Tcl_Obj *_objPtr = (objPtr); \ - if (_objPtr->refCount-- <= 1) { \ - TclFreeObj(_objPtr); \ - } \ + do { \ + Tcl_Obj *_objPtr = (objPtr); \ + if (_objPtr->refCount-- <= 1) { \ + TclFreeObj(_objPtr); \ + } \ } while(0) # undef Tcl_IsShared # define Tcl_IsShared(objPtr) \ @@ -2534,10 +2540,12 @@ static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line) * This will release the obj if there is no referece count, * otherwise let it be. */ -# define Tcl_BounceRefCount(objPtr) \ +# define Tcl_BounceRefCount(objPtr) \ TclBounceRefCount(objPtr); -static inline void TclBounceRefCount(Tcl_Obj* objPtr) +static inline void +TclBounceRefCount( + Tcl_Obj* objPtr) { if (objPtr) { if ((objPtr)->refCount == 0) { @@ -2589,10 +2597,10 @@ static inline void TclBounceRefCount(Tcl_Obj* objPtr) #define Tcl_GetHashValue(h) ((h)->clientData) #define Tcl_SetHashValue(h, value) ((h)->clientData = (void *)(value)) #define Tcl_GetHashKey(tablePtr, h) \ - ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ - (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ - ? (h)->key.oneWordValue \ - : (h)->key.string)) + ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ + (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ + ? (h)->key.oneWordValue \ + : (h)->key.string)) /* * Macros to use for clients to use to invoke find and create functions for diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index 3c4fac3..b52d1b3 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -47,17 +47,18 @@ typedef size_t caddr_t; */ union overhead { - union overhead *next; /* when free */ - unsigned char padding[TCL_ALLOCALIGN]; /* align struct to TCL_ALLOCALIGN bytes */ + union overhead *next; /* when free */ + unsigned char padding[TCL_ALLOCALIGN]; + /* align struct to TCL_ALLOCALIGN bytes */ struct { - unsigned char magic0; /* magic number */ - unsigned char index; /* bucket # */ - unsigned char unused; /* unused */ - unsigned char magic1; /* other magic number */ + unsigned char magic0; /* magic number */ + unsigned char index; /* bucket # */ + unsigned char unused; /* unused */ + unsigned char magic1; /* other magic number */ #ifndef NDEBUG - unsigned short rmagic; /* range magic number */ + unsigned short rmagic; /* range magic number */ size_t size; /* actual block size */ - unsigned short unused2; /* padding to 8-byte align */ + unsigned short unused2; /* padding to 8-byte align */ #endif } ovu; #define overMagic0 ovu.magic0 @@ -67,7 +68,6 @@ union overhead { #define realBlockSize ovu.size }; - #define MAGIC 0xEF /* magic # on accounting info */ #define RMAGIC 0x5555 /* magic # on range info */ @@ -92,7 +92,8 @@ union overhead { * precedes the data area returned to the user. */ -#define MINBLOCK ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) +#define MINBLOCK \ + ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) #define NBUCKETS (13 - (MINBLOCK >> 4)) #define MAXMALLOC ((size_t)1 << (NBUCKETS+2)) static union overhead *nextf[NBUCKETS]; @@ -251,7 +252,7 @@ TclFinalizeAllocSubsystem(void) void * TclpAlloc( - size_t numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { union overhead *overPtr; size_t bucket; @@ -385,10 +386,10 @@ TclpAlloc( static void MoreCore( - size_t bucket) /* What bucket to allocate to. */ + size_t bucket) /* What bucket to allocate to. */ { union overhead *overPtr; - size_t size; /* size of desired block */ + size_t size; /* size of desired block */ size_t amount; /* amount to allocate */ size_t numBlocks; /* how many blocks we get */ struct block *blockPtr; @@ -511,7 +512,7 @@ TclpFree( void * TclpRealloc( void *oldPtr, /* Pointer to alloc'ed block. */ - size_t numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { int i; union overhead *overPtr; @@ -743,7 +744,7 @@ TclpFree( void * TclpRealloc( void *oldPtr, /* Pointer to alloced block. */ - size_t numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { return realloc(oldPtr, numBytes); } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 3faa201..3940d4b 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -63,7 +63,6 @@ /* actually there is no fallback to builtin fpclassify */ #endif /* !TCL_FPCLASSIFY_MODE */ - /* * Bug 7371b6270b: to check C call stack depth, prefer an approach which is * compatible with AddressSanitizer (ASan) use-after-return detection. @@ -85,17 +84,17 @@ void * TclGetCStackPtr(void) { #if defined( __GNUC__ ) || __has_builtin(__builtin_frame_address) - return __builtin_frame_address(0); + return __builtin_frame_address(0); #elif defined(_MSC_VER) && defined(HAVE_INTRIN_H) - return _AddressOfReturnAddress(); + return _AddressOfReturnAddress(); #else - ptrdiff_t unused = 0; - /* - * LLVM recommends using volatile: - * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31 - */ - ptrdiff_t *volatile stackLevel = &unused; - return (void *)stackLevel; + ptrdiff_t unused = 0; + /* + * LLVM recommends using volatile: + * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31 + */ + ptrdiff_t *volatile stackLevel = &unused; + return (void *)stackLevel; #endif } @@ -168,7 +167,7 @@ TCL_DECLARE_MUTEX(commandTypeLock); * Static functions in this file: */ -static Tcl_ObjCmdProc BadEnsembleSubcommand; +static Tcl_ObjCmdProc BadEnsembleSubcommand; static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr, const char *oldName, const char *newName, int flags); @@ -193,12 +192,12 @@ static Tcl_ObjCmdProc ExprDoubleFunc; static Tcl_ObjCmdProc ExprFloorFunc; static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; -static Tcl_ObjCmdProc ExprIsFiniteFunc; -static Tcl_ObjCmdProc ExprIsInfinityFunc; -static Tcl_ObjCmdProc ExprIsNaNFunc; -static Tcl_ObjCmdProc ExprIsNormalFunc; -static Tcl_ObjCmdProc ExprIsSubnormalFunc; -static Tcl_ObjCmdProc ExprIsUnorderedFunc; +static Tcl_ObjCmdProc ExprIsFiniteFunc; +static Tcl_ObjCmdProc ExprIsInfinityFunc; +static Tcl_ObjCmdProc ExprIsNaNFunc; +static Tcl_ObjCmdProc ExprIsNormalFunc; +static Tcl_ObjCmdProc ExprIsSubnormalFunc; +static Tcl_ObjCmdProc ExprIsUnorderedFunc; static Tcl_ObjCmdProc ExprMaxFunc; static Tcl_ObjCmdProc ExprMinFunc; static Tcl_ObjCmdProc ExprRandFunc; @@ -207,7 +206,7 @@ static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; -static Tcl_ObjCmdProc FloatClassifyObjCmd; +static Tcl_ObjCmdProc FloatClassifyObjCmd; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; @@ -253,11 +252,11 @@ MODULE_SCOPE const TclStubs tclStubs; * after particular kinds of [yield]. */ -#define CORO_ACTIVATE_YIELD NULL -#define CORO_ACTIVATE_YIELDM INT2PTR(1) +#define CORO_ACTIVATE_YIELD NULL +#define CORO_ACTIVATE_YIELDM INT2PTR(1) -#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) -#define COROUTINE_ARGUMENTS_ARBITRARY (-2) +#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) +#define COROUTINE_ARGUMENTS_ARBITRARY (-2) /* * The following structure define the commands in the Tcl core. @@ -271,9 +270,9 @@ typedef struct { int flags; /* Various flag bits, as defined below. */ } CmdInfo; -#define CMD_IS_SAFE 1 /* Whether this command is part of the set of - * commands present by default in a safe - * interpreter. */ +#define CMD_IS_SAFE 1 /* Whether this command is part of the set of + * commands present by default in a safe + * interpreter. */ /* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle * expansion for itself rather than needing the generic layer to take care of * it for it. Defined in tclInt.h. */ @@ -287,13 +286,13 @@ typedef struct { */ typedef struct { - const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for - * the end of the list of commands to hide. */ - const char *commandName; /* The name of the command within the - * ensemble. If this is NULL, we want to also - * make the overall command be hidden, an ugly - * hack because it is expected by security - * policies in the wild. */ + const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for + * the end of the list of commands to hide. */ + const char *commandName; /* The name of the command within the + * ensemble. If this is NULL, we want to also + * make the overall command be hidden, an ugly + * hack because it is expected by security + * policies in the wild. */ } UnsafeEnsembleInfo; /* @@ -322,8 +321,8 @@ static const CmdInfo builtInCmds[] = { {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"const", Tcl_ConstObjCmd, TclCompileConstCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, - {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, - {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, + {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, + {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE}, {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE}, @@ -331,7 +330,7 @@ static const CmdInfo builtInCmds[] = { {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, - {"fpclassify", FloatClassifyObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"fpclassify", FloatClassifyObjCmd, NULL, NULL, CMD_IS_SAFE}, {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, @@ -346,12 +345,12 @@ static const CmdInfo builtInCmds[] = { {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, {"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, - {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, - {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, {"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE}, @@ -479,48 +478,52 @@ static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = { * Math functions. All are safe. */ +typedef double (BuiltinUnaryFunc)(double x); +typedef double (BuiltinBinaryFunc)(double x, double y); +#define BINARY_TYPECAST(fn) \ + (BuiltinUnaryFunc *)(void *)(BuiltinBinaryFunc *) fn typedef struct { const char *name; /* Name of the function. The full name is * "::tcl::mathfunc::". */ Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */ - double (*fn)(double x); /* Real function pointer */ + BuiltinUnaryFunc *fn; /* Real function pointer */ } BuiltinFuncDef; static const BuiltinFuncDef BuiltinFuncTable[] = { { "abs", ExprAbsFunc, NULL }, { "acos", ExprUnaryFunc, acos }, { "asin", ExprUnaryFunc, asin }, { "atan", ExprUnaryFunc, atan }, - { "atan2", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) atan2}, + { "atan2", ExprBinaryFunc, BINARY_TYPECAST(atan2) }, { "bool", ExprBoolFunc, NULL }, { "ceil", ExprCeilFunc, NULL }, - { "cos", ExprUnaryFunc, cos }, + { "cos", ExprUnaryFunc, cos }, { "cosh", ExprUnaryFunc, cosh }, { "double", ExprDoubleFunc, NULL }, { "entier", ExprIntFunc, NULL }, - { "exp", ExprUnaryFunc, exp }, + { "exp", ExprUnaryFunc, exp }, { "floor", ExprFloorFunc, NULL }, - { "fmod", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) fmod}, - { "hypot", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) hypot}, + { "fmod", ExprBinaryFunc, BINARY_TYPECAST(fmod) }, + { "hypot", ExprBinaryFunc, BINARY_TYPECAST(hypot) }, { "int", ExprIntFunc, NULL }, - { "isfinite", ExprIsFiniteFunc, NULL }, - { "isinf", ExprIsInfinityFunc, NULL }, - { "isnan", ExprIsNaNFunc, NULL }, - { "isnormal", ExprIsNormalFunc, NULL }, + { "isfinite", ExprIsFiniteFunc, NULL }, + { "isinf", ExprIsInfinityFunc, NULL }, + { "isnan", ExprIsNaNFunc, NULL }, + { "isnormal", ExprIsNormalFunc, NULL }, { "isqrt", ExprIsqrtFunc, NULL }, - { "issubnormal", ExprIsSubnormalFunc, NULL, }, - { "isunordered", ExprIsUnorderedFunc, NULL, }, - { "log", ExprUnaryFunc, log }, + { "issubnormal", ExprIsSubnormalFunc, NULL, }, + { "isunordered", ExprIsUnorderedFunc, NULL, }, + { "log", ExprUnaryFunc, log }, { "log10", ExprUnaryFunc, log10 }, { "max", ExprMaxFunc, NULL }, { "min", ExprMinFunc, NULL }, - { "pow", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) pow}, + { "pow", ExprBinaryFunc, BINARY_TYPECAST(pow) }, { "rand", ExprRandFunc, NULL }, { "round", ExprRoundFunc, NULL }, - { "sin", ExprUnaryFunc, sin }, + { "sin", ExprUnaryFunc, sin }, { "sinh", ExprUnaryFunc, sinh }, { "sqrt", ExprSqrtFunc, NULL }, { "srand", ExprSrandFunc, NULL }, - { "tan", ExprUnaryFunc, tan }, + { "tan", ExprUnaryFunc, tan }, { "tanh", ExprUnaryFunc, tanh }, { "wide", ExprWideFunc, NULL }, { NULL, NULL, NULL } @@ -628,8 +631,8 @@ TclFinalizeEvaluation(void) Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_DeleteHashTable(&commandTypeTable); - commandTypeInit = 0; + Tcl_DeleteHashTable(&commandTypeTable); + commandTypeInit = 0; } Tcl_MutexUnlock(&commandTypeLock); } @@ -668,8 +671,8 @@ buildInfoObjCmd2( char buf[80]; const char *p = strchr((char *)clientData, '.'); if (p) { - const char *q = strchr(p+1, '.'); - const char *r = strchr(p+1, '+'); + const char *q = strchr(p + 1, '.'); + const char *r = strchr(p + 1, '+'); p = (q < r) ? q : r; } if (p) { @@ -692,42 +695,45 @@ buildInfoObjCmd2( if (p) { if ((q = strchr(p, '.'))) { char buf[80]; - memcpy(buf, p+1, q - p - 1); + memcpy(buf, p + 1, q - p - 1); buf[q - p - 1] = '\0'; Tcl_AppendResult(interp, buf, (char *)NULL); } else { - Tcl_AppendResult(interp, p+1, (char *)NULL); + Tcl_AppendResult(interp, p + 1, (char *)NULL); } } return TCL_OK; } else if (len == 8 && !strcmp(arg, "compiler")) { const char *p = strchr((char *)clientData, '.'); while (p) { - if (!strncmp(p+1, "clang-", 6) || !strncmp(p+1, "gcc-", 4) - || !strncmp(p+1, "icc-", 4) || !strncmp(p+1, "msvc-", 5)) { - const char *q = strchr(p+1, '.'); + if (!strncmp(p + 1, "clang-", 6) + || !strncmp(p + 1, "gcc-", 4) + || !strncmp(p + 1, "icc-", 4) + || !strncmp(p + 1, "msvc-", 5)) { + const char *q = strchr(p + 1, '.'); if (q) { char buf[16]; - memcpy(buf, p+1, q - p - 1); + memcpy(buf, p + 1, q - p - 1); buf[q - p - 1] = '\0'; Tcl_AppendResult(interp, buf, (char *)NULL); } else { - Tcl_AppendResult(interp, p+1, (char *)NULL); + Tcl_AppendResult(interp, p + 1, (char *)NULL); } return TCL_OK; } - p = strchr(p+1, '.'); + p = strchr(p + 1, '.'); } Tcl_AppendResult(interp, "0", (char *)NULL); return TCL_OK; } const char *p = strchr((char *)clientData, '.'); while (p) { - if (!strncmp(p+1, arg, len) && ((p[len+1] == '.') || (p[len+1] == '\0'))) { + if (!strncmp(p + 1, arg, len) + && ((p[len + 1] == '.') || (p[len + 1] == '\0'))) { Tcl_AppendResult(interp, "1", (char *)NULL); return TCL_OK; } - p = strchr(p+1, '.'); + p = strchr(p + 1, '.'); } Tcl_AppendResult(interp, "0", (char *)NULL); return TCL_OK; @@ -819,16 +825,16 @@ Tcl_CreateInterp(void) #undef TclObjInterpProc if (commandTypeInit == 0) { - TclRegisterCommandTypeName(TclObjInterpProc, "proc"); - TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); - TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclChildObjCmd, "interp"); - TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); - TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); - TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); - TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); - TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); + TclRegisterCommandTypeName(TclObjInterpProc, "proc"); + TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); + TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclChildObjCmd, "interp"); + TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); + TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); + TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); + TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); + TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); } /* @@ -941,7 +947,7 @@ Tcl_CreateInterp(void) iPtr->flags |= INTERP_DEBUG_FRAME; #else if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) { - iPtr->flags |= INTERP_DEBUG_FRAME; + iPtr->flags |= INTERP_DEBUG_FRAME; } #endif @@ -967,7 +973,7 @@ Tcl_CreateInterp(void) */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ - framePtr = (CallFrame *)Tcl_Alloc(sizeof(CallFrame)); + framePtr = (CallFrame *) Tcl_Alloc(sizeof(CallFrame)); (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0); framePtr->objc = 0; @@ -997,7 +1003,7 @@ Tcl_CreateInterp(void) TclNewObj(iPtr->asyncCancelMsg); - cancelInfo = (CancelInfo *)Tcl_Alloc(sizeof(CancelInfo)); + cancelInfo = (CancelInfo *) Tcl_Alloc(sizeof(CancelInfo)); cancelInfo->interp = interp; iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo); @@ -1061,7 +1067,7 @@ Tcl_CreateInterp(void) */ #if TCL_THREADS && defined(USE_THREAD_ALLOC) - iPtr->allocCache = (AllocCache *)TclpGetAllocCache(); + iPtr->allocCache = (AllocCache *) TclpGetAllocCache(); #else iPtr->allocCache = NULL; #endif @@ -1085,7 +1091,7 @@ Tcl_CreateInterp(void) hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, cmdInfoPtr->name, &isNew); if (isNew) { - cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *) Tcl_Alloc(sizeof(Command)); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; cmdPtr->refCount = 1; @@ -1098,9 +1104,9 @@ Tcl_CreateInterp(void) cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; - if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { - cmdPtr->flags |= CMD_COMPILES_EXPANDED; - } + if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { + cmdPtr->flags |= CMD_COMPILES_EXPANDED; + } cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = cmdInfoPtr->nreProc; @@ -1160,15 +1166,15 @@ Tcl_CreateInterp(void) /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, - "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, - TclNRAssembleObjCmd, NULL, NULL); + "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, + TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRInjectObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype", - CoroTypeObjCmd, NULL, NULL); + CoroTypeObjCmd, NULL, NULL); /* Export unsupported commands */ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); @@ -1176,7 +1182,6 @@ Tcl_CreateInterp(void) Tcl_Export(interp, nsPtr, "*", 1); } - #ifdef USE_DTRACE /* * Register the tcl::dtrace command. @@ -1197,7 +1202,7 @@ Tcl_CreateInterp(void) memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN); for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL; builtinFuncPtr++) { - strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); + strcpy(mathFuncName + MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, builtinFuncPtr->objCmdProc, (void *)builtinFuncPtr->fn, NULL); Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0); @@ -1215,7 +1220,8 @@ Tcl_CreateInterp(void) #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ - TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)Tcl_Alloc(sizeof(TclOpCmdClientData)); + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) + Tcl_Alloc(sizeof(TclOpCmdClientData)); occdPtr->op = opcmdInfoPtr->name; occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; @@ -1321,7 +1327,7 @@ static void DeleteOpCmdClientData( void *clientData) { - TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; + TclOpCmdClientData *occdPtr = (TclOpCmdClientData *) clientData; Tcl_Free(occdPtr); } @@ -1331,10 +1337,10 @@ DeleteOpCmdClientData( * * TclRegisterCommandTypeName, TclGetCommandTypeName -- * - * Command type registration and lookup mechanism. Everything is keyed by - * the Tcl_ObjCmdProc for the command, and that is used as the *key* into - * the hash table that maps to constant strings that are names. (It is - * recommended that those names be ASCII.) + * Command type registration and lookup mechanism. Everything is keyed by + * the Tcl_ObjCmdProc for the command, and that is used as the *key* into + * the hash table that maps to constant strings that are names. (It is + * recommended that those names be ASCII.) * * --------------------------------------------------------------------- */ @@ -1348,21 +1354,21 @@ TclRegisterCommandTypeName( Tcl_MutexLock(&commandTypeLock); if (commandTypeInit == 0) { - Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); - commandTypeInit = 1; + Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); + commandTypeInit = 1; } if (nameStr != NULL) { - int isNew; + int isNew; - hPtr = Tcl_CreateHashEntry(&commandTypeTable, - implementationProc, &isNew); - Tcl_SetHashValue(hPtr, (void *) nameStr); + hPtr = Tcl_CreateHashEntry(&commandTypeTable, + implementationProc, &isNew); + Tcl_SetHashValue(hPtr, (void *) nameStr); } else { - hPtr = Tcl_FindHashEntry(&commandTypeTable, - implementationProc); - if (hPtr != NULL) { - Tcl_DeleteHashEntry(hPtr); - } + hPtr = Tcl_FindHashEntry(&commandTypeTable, + implementationProc); + if (hPtr != NULL) { + Tcl_DeleteHashEntry(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); } @@ -1376,15 +1382,15 @@ TclGetCommandTypeName( const char *name = "native"; if (procPtr == NULL) { - procPtr = cmdPtr->nreProc; + procPtr = cmdPtr->nreProc; } Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); - if (hPtr && Tcl_GetHashValue(hPtr)) { - name = (const char *) Tcl_GetHashValue(hPtr); - } + if (hPtr && Tcl_GetHashValue(hPtr)) { + name = (const char *) Tcl_GetHashValue(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); @@ -1424,41 +1430,43 @@ TclHideUnsafeCommands( } for (unsafePtr = unsafeEnsembleCommands; - unsafePtr->ensembleNsName; unsafePtr++) { - if (unsafePtr->commandName) { - /* - * Hide an ensemble subcommand. - */ - - Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - - if (TclRenameCommand(interp, TclGetString(cmdName), - "___tmp") != TCL_OK - || Tcl_HideCommand(interp, "___tmp", - TclGetString(hideName)) != TCL_OK) { - Tcl_Panic("problem making '%s %s' safe: %s", - unsafePtr->ensembleNsName, unsafePtr->commandName, - Tcl_GetStringResult(interp)); - } - Tcl_CreateObjCommand(interp, TclGetString(cmdName), - BadEnsembleSubcommand, (void *)unsafePtr, NULL); - TclDecrRefCount(cmdName); - TclDecrRefCount(hideName); - } else { - /* - * Hide an ensemble main command (for compatibility). - */ - - if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, - unsafePtr->ensembleNsName) != TCL_OK) { - Tcl_Panic("problem making '%s' safe: %s", - unsafePtr->ensembleNsName, - Tcl_GetStringResult(interp)); - } - } + unsafePtr->ensembleNsName; unsafePtr++) { + if (unsafePtr->commandName) { + /* + * Hide an ensemble subcommand. + */ + + Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + +#define INTERIM_HACK_NAME "___tmp" + + if (TclRenameCommand(interp, TclGetString(cmdName), + INTERIM_HACK_NAME) != TCL_OK + || Tcl_HideCommand(interp, INTERIM_HACK_NAME, + TclGetString(hideName)) != TCL_OK) { + Tcl_Panic("problem making '%s %s' safe: %s", + unsafePtr->ensembleNsName, unsafePtr->commandName, + Tcl_GetStringResult(interp)); + } + Tcl_CreateObjCommand(interp, TclGetString(cmdName), + BadEnsembleSubcommand, (void *)unsafePtr, NULL); + TclDecrRefCount(cmdName); + TclDecrRefCount(hideName); + } else { + /* + * Hide an ensemble main command (for compatibility). + */ + + if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, + unsafePtr->ensembleNsName) != TCL_OK) { + Tcl_Panic("problem making '%s' safe: %s", + unsafePtr->ensembleNsName, + Tcl_GetStringResult(interp)); + } + } } return TCL_OK; @@ -1492,8 +1500,8 @@ BadEnsembleSubcommand( const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData; Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "not allowed to invoke subcommand %s of %s", - infoPtr->commandName, infoPtr->ensembleNsName)); + "not allowed to invoke subcommand %s of %s", + infoPtr->commandName, infoPtr->ensembleNsName)); Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL); return TCL_ERROR; } @@ -1524,22 +1532,22 @@ Tcl_CallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; - int *assocDataCounterPtr = - (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); + int *assocDataCounterPtr = (int *) + Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; - AssocData *dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); + AssocData *dPtr = (AssocData *) Tcl_Alloc(sizeof(AssocData)); Tcl_HashEntry *hPtr; snprintf(buffer, sizeof(buffer), "Assoc Data Key #%d", *assocDataCounterPtr); (*assocDataCounterPtr)++; if (iPtr->assocData == NULL) { - iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->assocData = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew); @@ -1572,7 +1580,7 @@ Tcl_DontCallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTablePtr; @@ -1586,7 +1594,7 @@ Tcl_DontCallWhenDeleted( } for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - dPtr = (AssocData *)Tcl_GetHashValue(hPtr); + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) { Tcl_Free(dPtr); Tcl_DeleteHashEntry(hPtr); @@ -1620,7 +1628,7 @@ Tcl_SetAssocData( const char *name, /* Name for association. */ Tcl_InterpDeleteProc *proc, /* Proc to call when interpreter is about to * be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; AssocData *dPtr; @@ -1628,14 +1636,14 @@ Tcl_SetAssocData( int isNew; if (iPtr->assocData == NULL) { - iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + iPtr->assocData = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew); if (isNew == 0) { - dPtr = (AssocData *)Tcl_GetHashValue(hPtr); + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); } else { - dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); + dPtr = (AssocData *) Tcl_Alloc(sizeof(AssocData)); } dPtr->proc = proc; dPtr->clientData = clientData; @@ -1676,7 +1684,7 @@ Tcl_DeleteAssocData( if (hPtr == NULL) { return; } - dPtr = (AssocData *)Tcl_GetHashValue(hPtr); + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); @@ -1721,7 +1729,7 @@ Tcl_GetAssocData( if (hPtr == NULL) { return NULL; } - dPtr = (AssocData *)Tcl_GetHashValue(hPtr); + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); if (procPtr != NULL) { *procPtr = dPtr->proc; } @@ -1873,7 +1881,7 @@ DeleteInterpProc( Tcl_MutexLock(&cancelLock); hPtr = Tcl_FindHashEntry(&cancelTable, iPtr); if (hPtr != NULL) { - CancelInfo *cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); + CancelInfo *cancelInfo = (CancelInfo *) Tcl_GetHashValue(hPtr); if (cancelInfo != NULL) { if (cancelInfo->result != NULL) { @@ -1931,13 +1939,13 @@ DeleteInterpProc( hPtr = Tcl_FirstHashEntry(hTablePtr, &search); for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr)); + Tcl_DeleteCommandFromToken(interp, + (Tcl_Command) Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(hTablePtr); Tcl_Free(hTablePtr); } - if (iPtr->assocData != NULL) { AssocData *dPtr; @@ -1949,7 +1957,7 @@ DeleteInterpProc( for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search); hPtr != NULL; hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) { - dPtr = (AssocData *)Tcl_GetHashValue(hPtr); + dPtr = (AssocData *) Tcl_GetHashValue(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } @@ -2037,7 +2045,7 @@ DeleteInterpProc( for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - CmdFrame *cfPtr = (CmdFrame *)Tcl_GetHashValue(hPtr); + CmdFrame *cfPtr = (CmdFrame *) Tcl_GetHashValue(hPtr); Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); procPtr->iPtr = NULL; @@ -2061,7 +2069,7 @@ DeleteInterpProc( for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ExtCmdLoc *eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hPtr); + ExtCmdLoc *eclPtr = (ExtCmdLoc *) Tcl_GetHashValue(hPtr); if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); @@ -2190,7 +2198,7 @@ Tcl_HideCommand( Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" " token (rename)", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); return TCL_ERROR; } @@ -2213,9 +2221,9 @@ Tcl_HideCommand( if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only hide global namespace commands (use rename then hide)", - -1)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); + "can only hide global namespace commands (use rename then hide)", + -1)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } @@ -2225,7 +2233,7 @@ Tcl_HideCommand( hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; if (hiddenCmdTablePtr == NULL) { - hiddenCmdTablePtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + hiddenCmdTablePtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS); iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr; } @@ -2239,9 +2247,9 @@ Tcl_HideCommand( hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "hidden command named \"%s\" already exists", - hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); + "hidden command named \"%s\" already exists", + hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); return TCL_ERROR; } @@ -2343,9 +2351,9 @@ Tcl_ExposeCommand( if (strstr(cmdName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot expose to a namespace (use expose to toplevel, then rename)", - -1)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); + "cannot expose to a namespace (use expose to toplevel, then rename)", + -1)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } @@ -2360,12 +2368,12 @@ Tcl_ExposeCommand( } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown hidden command \"%s\"", hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", - hiddenCmdToken, (char *)NULL); + "unknown hidden command \"%s\"", hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", + hiddenCmdToken, (char *)NULL); return TCL_ERROR; } - cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); /* * Check that we have a true global namespace command (enforced by @@ -2399,8 +2407,8 @@ Tcl_ExposeCommand( hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "exposed command \"%s\" already exists", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); + "exposed command \"%s\" already exists", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); return TCL_ERROR; } @@ -2497,7 +2505,7 @@ Tcl_CreateCommand( * specified namespace; otherwise it is put in * the global namespace. */ Tcl_CmdProc *proc, /* Function to associate with cmdName. */ - void *clientData, /* Arbitrary value passed to string proc. */ + void *clientData, /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ @@ -2528,26 +2536,26 @@ Tcl_CreateCommand( */ while (1) { - /* - * Determine where the command should reside. If its name contains - * namespace qualifiers, we put it in the specified namespace; + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; * otherwise, we always put it in the global namespace. - */ + */ - if (strstr(cmdName, "::") != NULL) { + if (strstr(cmdName, "::") != NULL) { Namespace *dummy1, *dummy2; TclGetNamespaceForQualName(interp, cmdName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if ((nsPtr == NULL) || (tail == NULL)) { - return (Tcl_Command) NULL; + return (Tcl_Command) NULL; } - } else { + } else { nsPtr = iPtr->globalNsPtr; tail = cmdName; - } + } - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); if (isNew || deleted) { /* @@ -2558,10 +2566,10 @@ Tcl_CreateCommand( } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ - cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); /* * Be careful to preserve any existing import links so we can restore @@ -2616,7 +2624,7 @@ Tcl_CreateCommand( TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *) Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; @@ -2643,7 +2651,7 @@ Tcl_CreateCommand( cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; - dataPtr = (ImportedCmdData *)refCmdPtr->objClientData; + dataPtr = (ImportedCmdData *) refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; } @@ -2692,7 +2700,6 @@ typedef struct { Tcl_ObjCmdProc2 *nreProc; } CmdWrapperInfo; - static int cmdWrapperProc( void *clientData, @@ -2700,7 +2707,7 @@ cmdWrapperProc( int objc, Tcl_Obj * const *objv) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; if (objc < 0) { objc = -1; } @@ -2711,7 +2718,7 @@ static void cmdWrapperDeleteProc( void *clientData) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; clientData = info->deleteData; Tcl_CmdDeleteProc *deleteProc = info->deleteProc; @@ -2731,14 +2738,13 @@ Tcl_CreateObjCommand2( * the global namespace. */ Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ - Tcl_CmdDeleteProc *deleteProc + Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ -) { - CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *) Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = proc; info->clientData = clientData; info->deleteProc = deleteProc; @@ -2759,12 +2765,11 @@ Tcl_CreateObjCommand( * the global namespace. */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ - Tcl_CmdDeleteProc *deleteProc + Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ -) { Interp *iPtr = (Interp *) interp; Namespace *nsPtr; @@ -2805,11 +2810,11 @@ Tcl_Command TclCreateObjCommandInNs( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace - * components. */ - Tcl_Namespace *namesp, /* The namespace to create the command in */ + * components. */ + Tcl_Namespace *namesp, /* The namespace to create the command in */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when @@ -2841,10 +2846,10 @@ TclCreateObjCommandInNs( } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ - cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); /* * Command already exists; delete it. Be careful to preserve any @@ -2859,14 +2864,14 @@ TclCreateObjCommandInNs( } /* - * Make sure namespace doesn't get deallocated. - */ + * Make sure namespace doesn't get deallocated. + */ cmdPtr->nsPtr->refCount++; Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); nsPtr = (Namespace *) TclEnsureNamespace(interp, - (Tcl_Namespace *) cmdPtr->nsPtr); + (Tcl_Namespace *) cmdPtr->nsPtr); TclNsDecrRefCount(cmdPtr->nsPtr); if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) { @@ -2908,7 +2913,7 @@ TclCreateObjCommandInNs( TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } - cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); + cmdPtr = (Command *) Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; @@ -2936,7 +2941,7 @@ TclCreateObjCommandInNs( while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; - dataPtr = (ImportedCmdData*)refCmdPtr->objClientData; + dataPtr = (ImportedCmdData*) refCmdPtr->objClientData; cmdPtr->refCount++; TclCleanupCommandMacro(dataPtr->realCmdPtr); dataPtr->realCmdPtr = cmdPtr; @@ -2978,12 +2983,12 @@ TclCreateObjCommandInNs( int InvokeStringCommand( - void *clientData, /* Points to command's Command structure. */ + void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Command *cmdPtr = (Command *)clientData; + Command *cmdPtr = (Command *) clientData; int i, result; const char **argv = (const char **) TclStackAlloc(interp, (objc + 1) * sizeof(char *)); @@ -3052,10 +3057,10 @@ TclRenameCommand( cmdPtr = (Command *) cmd; if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't %s \"%s\": command doesn't exist", - ((newName == NULL)||(*newName == '\0'))? "delete":"rename", + "can't %s \"%s\": command doesn't exist", + ((newName == NULL) || (*newName == '\0')) ? "delete" : "rename", oldName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); return TCL_ERROR; } @@ -3085,16 +3090,16 @@ TclRenameCommand( if ((newNsPtr == NULL) || (newTail == NULL)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": bad command name", newName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); + "can't rename to \"%s\": bad command name", newName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); result = TCL_ERROR; goto done; } if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": command already exists", newName)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", - "TARGET_EXISTS", (char *)NULL); + "can't rename to \"%s\": command already exists", newName)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", + "TARGET_EXISTS", (char *)NULL); result = TCL_ERROR; goto done; } @@ -3266,7 +3271,7 @@ Tcl_SetCommandInfo( static int invokeObj2Command( - void *clientData, /* Points to command's Command structure. */ + void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -3293,7 +3298,7 @@ cmdWrapper2Proc( Tcl_Size objc, Tcl_Obj *const objv[]) { - Command *cmdPtr = (Command *)clientData; + Command *cmdPtr = (Command *) clientData; if (objc > INT_MAX) { return TclCommandWordLimitError(interp, objc); } @@ -3330,7 +3335,7 @@ Tcl_SetCommandInfoFromToken( cmdPtr->objClientData = infoPtr->objClientData; } if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { - CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; + CmdWrapperInfo *info = (CmdWrapperInfo *) cmdPtr->deleteData; if (infoPtr->objProc2 == NULL) { info->proc = invokeObj2Command; info->clientData = cmdPtr; @@ -3346,7 +3351,8 @@ Tcl_SetCommandInfoFromToken( info->deleteData = infoPtr->deleteData; } else { if ((infoPtr->objProc2 != NULL) && (infoPtr->objProc2 != cmdWrapper2Proc)) { - CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *) + Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = infoPtr->objProc2; info->clientData = infoPtr->objClientData2; info->nreProc = NULL; @@ -3437,7 +3443,7 @@ Tcl_GetCommandInfoFromToken( infoPtr->proc = cmdPtr->proc; infoPtr->clientData = cmdPtr->clientData; if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { - CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; + CmdWrapperInfo *info = (CmdWrapperInfo *) cmdPtr->deleteData; infoPtr->deleteProc = info->deleteProc; infoPtr->deleteData = info->deleteData; infoPtr->objProc2 = info->proc; @@ -3491,7 +3497,7 @@ Tcl_GetCommandName( return ""; } - return (const char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); + return (const char *) Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); } /* @@ -3541,7 +3547,8 @@ Tcl_GetCommandFullName( } } if (cmdPtr->hPtr != NULL) { - name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); + name = (char *) + Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); Tcl_AppendToObj(objPtr, name, -1); } } @@ -3666,7 +3673,7 @@ Tcl_DeleteCommandFromToken( if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; /* CallCommandTraces() does not cmdPtr, that's - * done just before Tcl_DeleteCommandFromToken() returns */ + * done just before Tcl_DeleteCommandFromToken() returns */ CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); /* @@ -3920,11 +3927,11 @@ CallCommandTraces( static int CancelEvalProc( - void *clientData, /* Interp to cancel the script in progress. */ + void *clientData, /* Interp to cancel the script in progress. */ TCL_UNUSED(Tcl_Interp *), int code) /* Current return code from command. */ { - CancelInfo *cancelInfo = (CancelInfo *)clientData; + CancelInfo *cancelInfo = (CancelInfo *) clientData; Interp *iPtr; if (cancelInfo != NULL) { @@ -3998,7 +4005,7 @@ CancelEvalProc( void TclCleanupCommand( - Command *cmdPtr) /* Points to the Command structure to + Command *cmdPtr) /* Points to the Command structure to * be freed. */ { if (cmdPtr->refCount-- <= 1) { @@ -4150,7 +4157,7 @@ Tcl_Canceled( */ if (!TclCanceled(iPtr)) { - return TCL_OK; + return TCL_OK; } /* @@ -4171,7 +4178,7 @@ Tcl_Canceled( */ if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) { - return TCL_OK; + return TCL_OK; } /* @@ -4180,34 +4187,34 @@ Tcl_Canceled( */ if (flags & TCL_LEAVE_ERR_MSG) { - const char *id, *message = NULL; - Tcl_Size length; + const char *id, *message = NULL; + Tcl_Size length; - /* - * Setup errorCode variables so that we can differentiate between - * being canceled and unwound. - */ + /* + * Setup errorCode variables so that we can differentiate between + * being canceled and unwound. + */ - if (iPtr->asyncCancelMsg != NULL) { - message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); - } else { - length = 0; - } + if (iPtr->asyncCancelMsg != NULL) { + message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); + } else { + length = 0; + } - if (iPtr->flags & TCL_CANCEL_UNWIND) { - id = "IUNWIND"; - if (length == 0) { - message = "eval unwound"; - } - } else { - id = "ICANCEL"; - if (length == 0) { - message = "eval canceled"; - } - } + if (iPtr->flags & TCL_CANCEL_UNWIND) { + id = "IUNWIND"; + if (length == 0) { + message = "eval unwound"; + } + } else { + id = "ICANCEL"; + if (length == 0) { + message = "eval canceled"; + } + } - Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); - Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); + Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); } /* @@ -4246,7 +4253,7 @@ Tcl_CancelEval( * script. */ Tcl_Obj *resultObjPtr, /* The script cancellation error message or * NULL for a default error message. */ - void *clientData, /* Passed to CancelEvalProc. */ + void *clientData, /* Passed to CancelEvalProc. */ int flags) /* Collection of OR-ed bits that control * the cancellation of the script. Only * TCL_CANCEL_UNWIND is currently @@ -4277,7 +4284,7 @@ Tcl_CancelEval( goto done; } - cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); + cancelInfo = (CancelInfo *) Tcl_GetHashValue(hPtr); /* * Populate information needed by the interpreter thread to fulfill the @@ -4289,7 +4296,8 @@ Tcl_CancelEval( if (resultObjPtr != NULL) { result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); - cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result,cancelInfo->length); + cancelInfo->result = (char *) + Tcl_Realloc(cancelInfo->result, cancelInfo->length); memcpy(cancelInfo->result, result, cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { @@ -4392,7 +4400,7 @@ TclNREvalObjv( */ if (iPtr->deferredCallbacks) { - iPtr->deferredCallbacks = NULL; + iPtr->deferredCallbacks = NULL; } else { TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); } @@ -4409,10 +4417,10 @@ EvalObjvCore( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - Command *cmdPtr = NULL, *preCmdPtr = (Command *)data[0]; + Command *cmdPtr = NULL, *preCmdPtr = (Command *) data[0]; int flags = PTR2INT(data[1]); int objc = PTR2INT(data[2]); - Tcl_Obj **objv = (Tcl_Obj **)data[3]; + Tcl_Obj **objv = (Tcl_Obj **) data[3]; Interp *iPtr = (Interp *) interp; Namespace *lookupNsPtr = NULL; int enterTracesDone = 0; @@ -4480,13 +4488,13 @@ EvalObjvCore( assert(cmdPtr == NULL); if (preCmdPtr) { /* - * Caller gave it to us. - */ + * Caller gave it to us. + */ if (!(preCmdPtr->flags & CMD_DEAD)) { /* - * So long as it exists, use it. - */ + * So long as it exists, use it. + */ cmdPtr = preCmdPtr; } else if (flags & TCL_EVAL_NORESOLVE) { @@ -4511,7 +4519,7 @@ EvalObjvCore( if (enterTracesDone || iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { Tcl_Obj *commandPtr = TclGetSourceFromFrame( - flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, + flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, objc, objv); Tcl_IncrRefCount(commandPtr); @@ -4554,7 +4562,7 @@ EvalObjvCore( cmdPtr->refCount++; TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc), - commandPtr, cmdPtr, objv); + commandPtr, cmdPtr, objv); } TclNRAddCallback(interp, Dispatch, @@ -4569,10 +4577,10 @@ Dispatch( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0]; + Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *) data[0]; void *clientData = data[1]; Tcl_Size objc = PTR2INT(data[2]); - Tcl_Obj **objv = (Tcl_Obj **)data[3]; + Tcl_Obj **objv = (Tcl_Obj **) data[3]; Interp *iPtr = (Interp *) interp; #ifdef USE_DTRACE @@ -4617,8 +4625,8 @@ TclNRRunCallbacks( * are to be run. */ { while (TOP_CB(interp) != rootPtr) { - NRE_callback *callbackPtr = TOP_CB(interp); - Tcl_NRPostProc *procPtr = callbackPtr->procPtr; + NRE_callback *callbackPtr = TOP_CB(interp); + Tcl_NRPostProc *procPtr = callbackPtr->procPtr; TOP_CB(interp) = callbackPtr->nextPtr; result = procPtr(callbackPtr->data, interp, result); @@ -4638,12 +4646,12 @@ NRCommand( iPtr->numLevels--; - /* - * If there is a tailcall, schedule it next - */ + /* + * If there is a tailcall, schedule it next + */ if (data[1] && (data[1] != INT2PTR(1))) { - listPtr = (Tcl_Obj *)data[1]; + listPtr = (Tcl_Obj *) data[1]; data[1] = NULL; TclNRAddCallback(interp, TclNRTailcallEval, listPtr, NULL, NULL, NULL); @@ -4737,7 +4745,7 @@ TEOV_RestoreVarFrame( Tcl_Interp *interp, int result) { - ((Interp *) interp)->varFramePtr = (CallFrame *)data[0]; + ((Interp *) interp)->varFramePtr = (CallFrame *) data[0]; return result; } @@ -4781,7 +4789,7 @@ TEOV_Error( const char *cmdString; Tcl_Size cmdLen; int objc = PTR2INT(data[0]); - Tcl_Obj **objv = (Tcl_Obj **)data[1]; + Tcl_Obj **objv = (Tcl_Obj **) data[1]; if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { /* @@ -4843,7 +4851,7 @@ TEOV_NotFound( TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; - newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); + newObjv = (Tcl_Obj **) TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); /* * Copy command prefix from unknown handler and add on the real command's @@ -4855,7 +4863,7 @@ TEOV_NotFound( newObjv[i] = handlerObjv[i]; Tcl_IncrRefCount(newObjv[i]); } - memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc); + memcpy(newObjv + handlerObjc, objv, sizeof(Tcl_Obj *) * objc); /* * Look up and invoke the handler (by recursive call to this function). If @@ -4870,9 +4878,9 @@ TEOV_NotFound( cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr); if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid command name \"%s\"", TclGetString(objv[0]))); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", - TclGetString(objv[0]), (char *)NULL); + "invalid command name \"%s\"", TclGetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", + TclGetString(objv[0]), (char *)NULL); /* * Release any resources we locked and allocated during the handler @@ -4904,8 +4912,8 @@ TEOV_NotFoundCallback( { Interp *iPtr = (Interp *) interp; int objc = PTR2INT(data[0]); - Tcl_Obj **objv = (Tcl_Obj **)data[1]; - Namespace *savedNsPtr = (Namespace *)data[2]; + Tcl_Obj **objv = (Tcl_Obj **) data[1]; + Namespace *savedNsPtr = (Namespace *) data[2]; int i; @@ -4985,9 +4993,9 @@ TEOV_RunLeaveTraces( Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; int objc = PTR2INT(data[0]); - Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; - Command *cmdPtr = (Command *)data[2]; - Tcl_Obj **objv = (Tcl_Obj **)data[3]; + Tcl_Obj *commandPtr = (Tcl_Obj *) data[1]; + Command *cmdPtr = (Command *) data[2]; + Tcl_Obj **objv = (Tcl_Obj **) data[3]; Tcl_Size length; const char *command = TclGetStringFromObj(commandPtr, &length); @@ -5071,7 +5079,7 @@ Tcl_EvalTokensStandard( * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - Tcl_Size count) /* Number of tokens to consider at tokenPtr. + Tcl_Size count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, @@ -5126,7 +5134,7 @@ TclEvalEx( * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ Tcl_Size line, /* The line the script starts on. */ - Tcl_Size *clNextOuter, /* Information about an outer context for */ + Tcl_Size *clNextOuter, /* Information about an outer context for */ const char *outerScript) /* continuation line data. This is set only in * TclSubstTokens(), to properly handle * [...]-nested commands. The 'outerScript' @@ -5162,15 +5170,18 @@ TclEvalEx( * state has been allocated while evaluating * the script, so that it can be freed * properly if an error occurs. */ - Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); - CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); + Tcl_Parse *parsePtr = (Tcl_Parse *) + TclStackAlloc(interp, sizeof(Tcl_Parse)); + CmdFrame *eeFramePtr = (CmdFrame *) + TclStackAlloc(interp, sizeof(CmdFrame)); Tcl_Obj **stackObjArray = (Tcl_Obj **) TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); - int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int)); - Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size)); + int *expandStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int)); + Tcl_Size *linesStack = (Tcl_Size *) + TclStackAlloc(interp, minObjs * sizeof(Tcl_Size)); /* TIP #280 Structures for tracking of command * locations. */ - Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible + Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible * continuation lines. Initialized only if the * caller gave us a table of locations to * track, via scriptCLLocPtr. It always refers @@ -5303,9 +5314,11 @@ TclEvalEx( */ if (numWords > minObjs) { - expand = (int *)Tcl_Alloc(numWords * sizeof(int)); - objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); - lineSpace = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size)); + expand = (int *) Tcl_Alloc(numWords * sizeof(int)); + objvSpace = (Tcl_Obj **) + Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); + lineSpace = (Tcl_Size *) + Tcl_Alloc(numWords * sizeof(Tcl_Size)); } expandRequested = 0; objv = objvSpace; @@ -5314,7 +5327,7 @@ TclEvalEx( iPtr->cmdFramePtr = eeFramePtr->nextPtr; for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr; objectsUsed < numWords; - objectsUsed++, tokenPtr += tokenPtr->numComponents+1) { + objectsUsed++, tokenPtr += tokenPtr->numComponents + 1) { Tcl_Size additionalObjsCount; /* @@ -5337,7 +5350,7 @@ TclEvalEx( iPtr->evalFlags |= TCL_EVAL_FILE; } - code = TclSubstTokens(interp, tokenPtr+1, + code = TclSubstTokens(interp, tokenPtr + 1, tokenPtr->numComponents, NULL, wordLine, wordCLNext, outerScript); @@ -5359,7 +5372,8 @@ TclEvalEx( */ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (expanding word %" TCL_SIZE_MODIFIER "d)", objectsUsed)); + "\n (expanding word %" TCL_SIZE_MODIFIER "d)", + objectsUsed)); Tcl_DecrRefCount(objv[objectsUsed]); break; } @@ -5402,9 +5416,10 @@ TclEvalEx( Tcl_Size objIdx = objectsNeeded - 1; if ((numWords > minObjs) || (objectsNeeded > minObjs)) { - objv = objvSpace = - (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); - lines = lineSpace = (Tcl_Size *)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size)); + objv = objvSpace = (Tcl_Obj **) + Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); + lines = lineSpace = (Tcl_Size *) + Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size)); } objectsUsed = 0; @@ -5428,7 +5443,7 @@ TclEvalEx( objectsUsed++; } } - objv += objIdx+1; + objv += objIdx + 1; if (copy != stackObjArray) { Tcl_Free(copy); @@ -5725,7 +5740,7 @@ TclArgumentEnter( * and initialize references. */ - cfwPtr = (CFWord *)Tcl_Alloc(sizeof(CFWord)); + cfwPtr = (CFWord *) Tcl_Alloc(sizeof(CFWord)); cfwPtr->framePtr = cfPtr; cfwPtr->word = i; cfwPtr->refCount = 1; @@ -5736,7 +5751,7 @@ TclArgumentEnter( * relevant. Just remember the reference to prevent early removal. */ - cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); + cfwPtr = (CFWord *) Tcl_GetHashValue(hPtr); cfwPtr->refCount++; } } @@ -5773,13 +5788,12 @@ TclArgumentRelease( for (i = 1; i < objc; i++) { CFWord *cfwPtr; - Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]); if (!hPtr) { continue; } - cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); + cfwPtr = (CFWord *) Tcl_GetHashValue(hPtr); if (cfwPtr->refCount-- > 1) { continue; @@ -5825,13 +5839,12 @@ TclArgumentBCEnter( ECL *ePtr; CFWordBC *lastPtr = NULL; Interp *iPtr = (Interp *) interp; - Tcl_HashEntry *hePtr = - Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); + Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); if (!hePtr) { return; } - eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr); + eclPtr = (ExtCmdLoc *) Tcl_GetHashValue(hePtr); ePtr = &eclPtr->loc[cmd]; /* @@ -5848,7 +5861,7 @@ TclArgumentBCEnter( */ if (ePtr->nline != objc) { - return; + return; } /* @@ -5866,8 +5879,8 @@ TclArgumentBCEnter( if (ePtr->line[word] >= 0) { int isNew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, - objv[word], &isNew); - CFWordBC *cfwPtr = (CFWordBC *)Tcl_Alloc(sizeof(CFWordBC)); + objv[word], &isNew); + CFWordBC *cfwPtr = (CFWordBC *) Tcl_Alloc(sizeof(CFWordBC)); cfwPtr->framePtr = cfPtr; cfwPtr->obj = objv[word]; @@ -5891,7 +5904,7 @@ TclArgumentBCEnter( * information in the new structure. */ - cfwPtr->prevPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); + cfwPtr->prevPtr = (CFWordBC *) Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, cfwPtr); @@ -5933,7 +5946,7 @@ TclArgumentBCRelease( CFWordBC *nextPtr = cfwPtr->nextPtr; Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, cfwPtr->obj); - CFWordBC *xPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); + CFWordBC *xPtr = (CFWordBC *) Tcl_GetHashValue(hPtr); if (xPtr != cfwPtr) { Tcl_Panic("TclArgumentBC Enter/Release Mismatch"); @@ -5999,7 +6012,7 @@ TclArgumentGet( hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, obj); if (hPtr) { - CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); + CFWord *cfwPtr = (CFWord *) Tcl_GetHashValue(hPtr); *wordPtr = cfwPtr->word; *cfPtrPtr = cfwPtr->framePtr; @@ -6013,7 +6026,7 @@ TclArgumentGet( hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, obj); if (hPtr) { - CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); + CFWordBC *cfwPtr = (CFWordBC *) Tcl_GetHashValue(hPtr); framePtr = cfwPtr->framePtr; framePtr->data.tebc.pc = (char *) (((ByteCode *) @@ -6056,7 +6069,7 @@ 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 + 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 @@ -6069,7 +6082,7 @@ 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 + 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 @@ -6088,7 +6101,7 @@ 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 + 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 @@ -6152,7 +6165,7 @@ TclNREvalObjEx( * should be pushed, as needed by alias and ensemble redirections. */ - eoFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); + eoFramePtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame)); eoFramePtr->nline = 0; eoFramePtr->line = NULL; @@ -6173,7 +6186,7 @@ TclNREvalObjEx( } TclMarkTailcall(interp); - TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, + TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); TclListObjGetElements(NULL, listPtr, &objc, &objv); @@ -6194,9 +6207,9 @@ TclNREvalObjEx( * iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ - if (TclInterpReady(interp) != TCL_OK) { - return TCL_ERROR; - } + if (TclInterpReady(interp) != TCL_OK) { + return TCL_ERROR; + } if (flags & TCL_EVAL_GLOBAL) { savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; @@ -6206,7 +6219,7 @@ TclNREvalObjEx( TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr, objPtr, INT2PTR(allowExceptions), NULL); - return TclNRExecuteByteCode(interp, codePtr); + return TclNRExecuteByteCode(interp, codePtr); } { @@ -6261,8 +6274,8 @@ TEOEx_ByteCodeCallback( int result) { Interp *iPtr = (Interp *) interp; - CallFrame *savedVarFramePtr = (CallFrame *)data[0]; - Tcl_Obj *objPtr = (Tcl_Obj *)data[1]; + CallFrame *savedVarFramePtr = (CallFrame *) data[0]; + Tcl_Obj *objPtr = (Tcl_Obj *) data[1]; int allowExceptions = PTR2INT(data[2]); if (iPtr->numLevels == 0) { @@ -6307,9 +6320,9 @@ TEOEx_ListCallback( int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; - CmdFrame *eoFramePtr = (CmdFrame *)data[1]; - Tcl_Obj *objPtr = (Tcl_Obj *)data[2]; + Tcl_Obj *listPtr = (Tcl_Obj *) data[0]; + CmdFrame *eoFramePtr = (CmdFrame *) data[1]; + Tcl_Obj *objPtr = (Tcl_Obj *) data[2]; /* * Remove the cmdFrame @@ -6489,7 +6502,7 @@ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ long *ptr) /* Where to store long result. */ { Tcl_Obj *resultPtr; @@ -6502,7 +6515,7 @@ Tcl_ExprLongObj( return TCL_ERROR; } - if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) { + if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type) != TCL_OK) { return TCL_ERROR; } @@ -6536,7 +6549,7 @@ int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ double *ptr) /* Where to store double result. */ { Tcl_Obj *resultPtr; @@ -6612,7 +6625,7 @@ int TclObjInvokeNamespace( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ Tcl_Namespace *nsPtr, /* The namespace to use. */ @@ -6656,7 +6669,7 @@ int TclObjInvoke( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ int flags) /* Combination of flags controlling the call: @@ -6668,7 +6681,7 @@ TclObjInvoke( } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal argument vector", -1)); + "illegal argument vector", -1)); return TCL_ERROR; } if ((flags & TCL_INVOKE_HIDDEN) == 0) { @@ -6697,12 +6710,12 @@ TclNRInvoke( } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid hidden command name \"%s\"", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, - (char *)NULL); + "invalid hidden command name \"%s\"", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, + (char *)NULL); return TCL_ERROR; } - cmdPtr = (Command *)Tcl_GetHashValue(hPtr); + cmdPtr = (Command *) Tcl_GetHashValue(hPtr); /* * Avoid the exception-handling brain damage when numLevels == 0 @@ -6726,7 +6739,7 @@ NRPostInvoke( Tcl_Interp *interp, int result) { - Interp *iPtr = (Interp *)interp; + Interp *iPtr = (Interp *) interp; iPtr->numLevels--; return result; @@ -7187,7 +7200,7 @@ ExprIsqrtFunc( negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "square root of negative argument", -1)); + "square root of negative argument", -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", (char *)NULL); return TCL_ERROR; @@ -7247,7 +7260,7 @@ ExprSqrtFunc( static int ExprUnaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes one double argument and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the @@ -7257,7 +7270,7 @@ ExprUnaryFunc( { int code; double d; - double (*func)(double) = (double (*)(double)) clientData; + BuiltinUnaryFunc *func = (BuiltinUnaryFunc *) clientData; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); @@ -7311,7 +7324,7 @@ CheckDoubleResult( static int ExprBinaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes two double arguments and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the @@ -7321,7 +7334,7 @@ ExprBinaryFunc( { int code; double d1, d2; - double (*func)(double, double) = (double (*)(double, double)) clientData; + BuiltinBinaryFunc *func = (BuiltinBinaryFunc *) clientData; if (objc != 3) { MathFuncWrongNumArgs(interp, 3, objc, objv); @@ -7397,13 +7410,14 @@ ExprAbsFunc( Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); return TCL_OK; } - bytes++; numBytes--; + bytes++; + numBytes--; } } goto unChanged; } else if (l == WIDE_MIN) { if (sizeof(Tcl_WideInt) > sizeof(int64_t)) { - Tcl_WideUInt ul = -(Tcl_WideUInt)WIDE_MIN; + Tcl_WideUInt ul = -(Tcl_WideUInt) WIDE_MIN; if (mp_init(&big) != MP_OKAY || mp_unpack(&big, 1, 1, sizeof(Tcl_WideInt), 0, 0, &ul) != MP_OKAY) { return TCL_ERROR; @@ -7539,7 +7553,7 @@ ExprIntFunc( if (type == TCL_NUMBER_DOUBLE) { d = *((const double *) ptr); - if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) { + if ((d >= (double) WIDE_MAX) || (d <= (double) WIDE_MIN)) { mp_int big; if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { @@ -7615,20 +7629,20 @@ ExprMaxMinFunc( } res = objv[1]; for (i = 1; i < objc; i++) { - if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { - return TCL_ERROR; - } - if (type == TCL_NUMBER_NAN) { - /* - * Get the error message for NaN. - */ - - Tcl_GetDoubleFromObj(interp, objv[i], &d); - return TCL_ERROR; - } - if (TclCompareTwoNumbers(objv[i], res) == op) { - res = objv[i]; - } + if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type == TCL_NUMBER_NAN) { + /* + * Get the error message for NaN. + */ + + Tcl_GetDoubleFromObj(interp, objv[i], &d); + return TCL_ERROR; + } + if (TclCompareTwoNumbers(objv[i], res) == op) { + res = objv[i]; + } } Tcl_SetObjResult(interp, res); @@ -7684,7 +7698,7 @@ ExprRandFunc( * take into consideration the thread this interp is running in. */ - iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread())*4093U; + iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread()) * 4093U; /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. @@ -7781,7 +7795,7 @@ ExprRoundFunc( } else if (fractPart >= 0.5) { max--; } - if ((intPart >= (double)max) || (intPart <= (double)min)) { + if ((intPart >= (double) max) || (intPart <= (double) min)) { mp_int big; mp_err err = MP_OKAY; @@ -7800,7 +7814,7 @@ ExprRoundFunc( Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; } else { - Tcl_WideInt result = (Tcl_WideInt)intPart; + Tcl_WideInt result = (Tcl_WideInt) intPart; if (fractPart <= -0.5) { result--; @@ -7881,8 +7895,8 @@ ExprSrandFunc( * This page contains the functions that implement all of the built-in * math functions for classifying IEEE doubles. * - * These have to be a little bit careful while Tcl_GetDoubleFromObj() - * rejects NaN values, which these functions *explicitly* accept. + * These have to be a little bit careful while Tcl_GetDoubleFromObj() + * rejects NaN values, which these functions *explicitly* accept. * * Results: * Each function returns TCL_OK if it succeeds and pushes an Tcl object @@ -7916,16 +7930,16 @@ ClassifyDouble( * Hence we define those here. */ #ifndef FP_NAN -# define FP_NAN 1 /* Value is NaN */ -# define FP_INFINITE 2 /* Value is an infinity */ -# define FP_ZERO 3 /* Value is a zero */ -# define FP_NORMAL 4 /* Value is a normal float */ -# define FP_SUBNORMAL 5 /* Value has lost accuracy */ +# define FP_NAN 1 /* Value is NaN */ +# define FP_INFINITE 2 /* Value is an infinity */ +# define FP_ZERO 3 /* Value is a zero */ +# define FP_NORMAL 4 /* Value is a normal float */ +# define FP_SUBNORMAL 5 /* Value has lost accuracy */ #endif /* !FP_NAN */ #if TCL_FPCLASSIFY_MODE == 3 return __builtin_fpclassify( - FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); + FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); #elif TCL_FPCLASSIFY_MODE == 2 /* * We assume this hack is only needed on little-endian systems. @@ -7935,27 +7949,27 @@ ClassifyDouble( */ union { - double d; /* Interpret as double */ - struct { - unsigned int low; /* Lower 32 bits */ - unsigned int high; /* Upper 32 bits */ - } w; /* Interpret as unsigned integer words */ - } doubleMeaning; /* So we can look at the representation of a - * double directly. Platform (i.e., processor) - * specific; this is for x86 (and most other - * little-endian processors, but those are - * untested). */ + double d; /* Interpret as double */ + struct { + unsigned int low; /* Lower 32 bits */ + unsigned int high; /* Upper 32 bits */ + } w; /* Interpret as unsigned integer words */ + } doubleMeaning; /* So we can look at the representation of a + * double directly. Platform (i.e., processor) + * specific; this is for x86 (and most other + * little-endian processors, but those are + * untested). */ unsigned int exponent, mantissaLow, mantissaHigh; - /* The pieces extracted from the double. */ - int zeroMantissa; /* Was the mantissa zero? That's special. */ + /* The pieces extracted from the double. */ + int zeroMantissa; /* Was the mantissa zero? That's special. */ /* * Shifts and masks to use with the doubleMeaning variable above. */ -#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ -#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ -#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ +#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ +#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ +#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ /* * Extract the exponent (11 bits) and mantissa (52 bits). Note that we @@ -7974,43 +7988,43 @@ ClassifyDouble( switch (exponent) { case 0: - /* - * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. - */ + /* + * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. + */ - return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; + return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; case EXPONENT_MASK: - /* - * When the exponent is all ones, it's an INF or a NAN. - */ + /* + * When the exponent is all ones, it's an INF or a NAN. + */ - return zeroMantissa ? FP_INFINITE : FP_NAN; + return zeroMantissa ? FP_INFINITE : FP_NAN; default: - /* - * Everything else is a NORMAL double precision float. - */ + /* + * Everything else is a NORMAL double precision float. + */ - return FP_NORMAL; + return FP_NORMAL; } #elif TCL_FPCLASSIFY_MODE == 1 switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: - return FP_ZERO; + return FP_ZERO; case _FPCLASS_NN: case _FPCLASS_PN: - return FP_NORMAL; + return FP_NORMAL; case _FPCLASS_ND: case _FPCLASS_PD: - return FP_SUBNORMAL; + return FP_SUBNORMAL; case _FPCLASS_NINF: case _FPCLASS_PINF: - return FP_INFINITE; + return FP_INFINITE; default: - Tcl_Panic("result of _fpclass() outside documented range!"); + Tcl_Panic("result of _fpclass() outside documented range!"); case _FPCLASS_QNAN: case _FPCLASS_SNAN: - return FP_NAN; + return FP_NAN; } #else /* TCL_FPCLASSIFY_MODE not in (0..3) */ #error "unknown or unexpected TCL_FPCLASSIFY_MODE" @@ -8036,14 +8050,14 @@ ExprIsFiniteFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - type = ClassifyDouble(d); - result = (type != FP_INFINITE && type != FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + type = ClassifyDouble(d); + result = (type != FP_INFINITE && type != FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8067,13 +8081,13 @@ ExprIsInfinityFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_INFINITE); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_INFINITE); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8097,13 +8111,13 @@ ExprIsNaNFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8127,13 +8141,13 @@ ExprIsNormalFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8157,13 +8171,13 @@ ExprIsSubnormalFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_SUBNORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_SUBNORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8187,23 +8201,23 @@ ExprIsUnorderedFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result = 1; + result = 1; } else { - d = *((const double *) ptr); - result = (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result = (ClassifyDouble(d) == FP_NAN); } if (Tcl_GetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result |= 1; + result |= 1; } else { - d = *((const double *) ptr); - result |= (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result |= (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); @@ -8224,39 +8238,39 @@ FloatClassifyObjCmd( int type; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); + Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - goto gotNaN; + goto gotNaN; } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } switch (ClassifyDouble(d)) { case FP_INFINITE: - TclNewLiteralStringObj(objPtr, "infinite"); - break; + TclNewLiteralStringObj(objPtr, "infinite"); + break; case FP_NAN: gotNaN: - TclNewLiteralStringObj(objPtr, "nan"); - break; + TclNewLiteralStringObj(objPtr, "nan"); + break; case FP_NORMAL: - TclNewLiteralStringObj(objPtr, "normal"); - break; + TclNewLiteralStringObj(objPtr, "normal"); + break; case FP_SUBNORMAL: - TclNewLiteralStringObj(objPtr, "subnormal"); - break; + TclNewLiteralStringObj(objPtr, "subnormal"); + break; case FP_ZERO: - TclNewLiteralStringObj(objPtr, "zero"); - break; + TclNewLiteralStringObj(objPtr, "zero"); + break; default: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to classify number: %f", d)); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to classify number: %f", d)); + return TCL_ERROR; } Tcl_SetObjResult(interp, objPtr); return TCL_OK; @@ -8289,10 +8303,10 @@ MathFuncWrongNumArgs( const char *name = TclGetString(objv[0]); const char *tail = name + strlen(name); - while (tail > name+1) { + while (tail > name + 1) { tail--; if (*tail == ':' && tail[-1] == ':') { - name = tail+1; + name = tail + 1; break; } } @@ -8487,14 +8501,14 @@ wrapperNRObjProc( int objc, Tcl_Obj *const objv[]) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; clientData = info->clientData; Tcl_ObjCmdProc2 *proc = info->proc; Tcl_Free(info); if (objc < 0) { objc = -1; } - return proc(clientData, interp, (Tcl_Size)objc, objv); + return proc(clientData, interp, (Tcl_Size) objc, objv); } int @@ -8511,7 +8525,8 @@ Tcl_NRCallObjProc2( } NRE_callback *rootPtr = TOP_CB(interp); - CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *) + Tcl_Alloc(sizeof(CmdWrapperInfo)); info->clientData = clientData; info->proc = objProc; @@ -8555,7 +8570,8 @@ cmdWrapperNreProc( int objc, Tcl_Obj *const objv[]) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; + if (objc < 0) { objc = -1; } @@ -8575,13 +8591,15 @@ Tcl_NRCreateCommand2( * calls. */ Tcl_ObjCmdProc2 *nreProc, /* Object-based function to associate with * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { - CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + CmdWrapperInfo *info = (CmdWrapperInfo *) + Tcl_Alloc(sizeof(CmdWrapperInfo)); + info->proc = proc; info->clientData = clientData; info->nreProc = nreProc; @@ -8606,7 +8624,7 @@ Tcl_NRCreateCommand( * calls. */ Tcl_ObjCmdProc *nreProc, /* Object-based function to associate with * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when @@ -8614,7 +8632,7 @@ Tcl_NRCreateCommand( { Command *cmdPtr = (Command *) Tcl_CreateObjCommand(interp, cmdName, proc, clientData, - deleteProc); + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; @@ -8631,8 +8649,8 @@ TclNRCreateCommandInNs( Tcl_CmdDeleteProc *deleteProc) { Command *cmdPtr = (Command *) - TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, - deleteProc); + TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; @@ -8655,7 +8673,7 @@ int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - Tcl_Size objc, /* Number of words in command. */ + Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the @@ -8714,8 +8732,8 @@ TclMarkTailcall( if (iPtr->deferredCallbacks == NULL) { TclNRAddCallback(interp, NRCommand, NULL, NULL, - NULL, NULL); - iPtr->deferredCallbacks = TOP_CB(interp); + NULL, NULL); + iPtr->deferredCallbacks = TOP_CB(interp); } } @@ -8762,12 +8780,12 @@ TclSetTailcall( NRE_callback *runPtr; for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { - if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { - break; - } + if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { + break; + } } if (!runPtr) { - Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); + Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); } runPtr->data[1] = listPtr; } @@ -8803,9 +8821,9 @@ TclNRTailcallObjCmd( } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tailcall can only be called from a proc, lambda or method", -1)); - Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "tailcall can only be called from a proc, lambda or method", -1)); + Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); return TCL_ERROR; } @@ -8815,8 +8833,8 @@ TclNRTailcallObjCmd( */ if (iPtr->varFramePtr->tailcallPtr) { - Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); - iPtr->varFramePtr->tailcallPtr = NULL; + Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); + iPtr->varFramePtr->tailcallPtr = NULL; } /* @@ -8826,19 +8844,19 @@ TclNRTailcallObjCmd( */ if (objc > 1) { - Tcl_Obj *listPtr, *nsObjPtr; - Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; + Tcl_Obj *listPtr, *nsObjPtr; + Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; - /* - * The tailcall data is in a Tcl list: the first element is the - * namespace, the rest the command to be tailcalled. - */ + /* + * The tailcall data is in a Tcl list: the first element is the + * namespace, the rest the command to be tailcalled. + */ - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); - listPtr = Tcl_NewListObj(objc, objv); + nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); + listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); - iPtr->varFramePtr->tailcallPtr = listPtr; + iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } @@ -8860,7 +8878,7 @@ TclNRTailcallEval( int result) { Interp *iPtr = (Interp *) interp; - Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr; + Tcl_Obj *listPtr = (Tcl_Obj *) data[0], *nsObjPtr; Tcl_Namespace *nsPtr; Tcl_Size objc; Tcl_Obj **objv; @@ -8873,13 +8891,13 @@ TclNRTailcallEval( } if (result != TCL_OK) { - /* - * Tailcall execution was preempted, eg by an intervening catch or by - * a now-gone namespace: cleanup and return. - */ + /* + * Tailcall execution was preempted, eg by an intervening catch or by + * a now-gone namespace: cleanup and return. + */ Tcl_DecrRefCount(listPtr); - return result; + return result; } /* @@ -8889,7 +8907,7 @@ TclNRTailcallEval( TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; - return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL); + return TclNREvalObjv(interp, objc - 1, objv + 1, 0, NULL); } int @@ -8966,7 +8984,7 @@ TclNRYieldObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yield can only be called in a coroutine", -1)); + "yield can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } @@ -8977,7 +8995,7 @@ TclNRYieldObjCmd( NRE_ASSERT(!COR_IS_SUSPENDED(corPtr)); TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - clientData, NULL, NULL); + clientData, NULL, NULL); return TCL_OK; } @@ -8999,17 +9017,17 @@ TclNRYieldToObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto can only be called in a coroutine", -1)); + "yieldto can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } if (((Namespace *) nsPtr)->flags & NS_DYING) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto called in deleted namespace", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", (char *)NULL); - return TCL_ERROR; + return TCL_ERROR; } /* @@ -9041,7 +9059,7 @@ RewindCoroutineCallback( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - return Tcl_RestoreInterpState(interp, (Tcl_InterpState)data[0]); + return Tcl_RestoreInterpState(interp, (Tcl_InterpState) data[0]); } static int @@ -9066,7 +9084,7 @@ static void DeleteCoroutine( void *clientData) { - CoroutineData *corPtr = (CoroutineData *)clientData; + CoroutineData *corPtr = (CoroutineData *) clientData; Tcl_Interp *interp = corPtr->eePtr->interp; NRE_callback *rootPtr = TOP_CB(interp); @@ -9081,7 +9099,7 @@ NRCoroutineCallerCallback( Tcl_Interp *interp, int result) { - CoroutineData *corPtr = (CoroutineData *)data[0]; + CoroutineData *corPtr = (CoroutineData *) data[0]; Command *cmdPtr = corPtr->cmdPtr; /* @@ -9127,7 +9145,7 @@ NRCoroutineExitCallback( Tcl_Interp *interp, int result) { - CoroutineData *corPtr = (CoroutineData *)data[0]; + CoroutineData *corPtr = (CoroutineData *) data[0]; Command *cmdPtr = corPtr->cmdPtr; /* @@ -9174,14 +9192,14 @@ NRCoroutineExitCallback( * * TclNRCoroutineActivateCallback -- * - * This is the workhorse for coroutines: it implements both yield and - * resume. + * This is the workhorse for coroutines: it implements both yield and + * resume. * - * It is important that both be implemented in the same callback: the - * detection of the impossibility to suspend due to a busy C-stack relies - * on the precise position of a local variable in the stack. We do not - * want the compiler to play tricks on us, either by moving things around - * or inlining. + * It is important that both be implemented in the same callback: the + * detection of the impossibility to suspend due to a busy C-stack relies + * on the precise position of a local variable in the stack. We do not + * want the compiler to play tricks on us, either by moving things around + * or inlining. * *---------------------------------------------------------------------- */ @@ -9192,46 +9210,46 @@ TclNRCoroutineActivateCallback( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - CoroutineData *corPtr = (CoroutineData *)data[0]; + CoroutineData *corPtr = (CoroutineData *) data[0]; void *stackLevel = TclGetCStackPtr(); if (!corPtr->stackLevel) { - /* - * -- Coroutine is suspended -- - * Push the callback to restore the caller's context on yield or - * return. - */ - - TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); - - /* - * Record the stackLevel at which the resume is happening, then swap - * the interp's environment to make it suitable to run this coroutine. - */ - - corPtr->stackLevel = stackLevel; - Tcl_Size numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = iPtr->numLevels; - - SAVE_CONTEXT(corPtr->caller); - corPtr->callerEEPtr = iPtr->execEnvPtr; - RESTORE_CONTEXT(corPtr->running); - iPtr->execEnvPtr = corPtr->eePtr; - iPtr->numLevels += numLevels; + /* + * -- Coroutine is suspended -- + * Push the callback to restore the caller's context on yield or + * return. + */ + + TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, + NULL, NULL, NULL); + + /* + * Record the stackLevel at which the resume is happening, then swap + * the interp's environment to make it suitable to run this coroutine. + */ + + corPtr->stackLevel = stackLevel; + Tcl_Size numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = iPtr->numLevels; + + SAVE_CONTEXT(corPtr->caller); + corPtr->callerEEPtr = iPtr->execEnvPtr; + RESTORE_CONTEXT(corPtr->running); + iPtr->execEnvPtr = corPtr->eePtr; + iPtr->numLevels += numLevels; } else { - /* - * Coroutine is active: yield - */ + /* + * Coroutine is active: yield + */ - if (corPtr->stackLevel != stackLevel) { + if (corPtr->stackLevel != stackLevel) { NRE_callback *runPtr; iPtr->execEnvPtr = corPtr->callerEEPtr; if (corPtr->yieldPtr) { for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { if (runPtr->data[1] == corPtr->yieldPtr) { - Tcl_DecrRefCount((Tcl_Obj *)runPtr->data[1]); + Tcl_DecrRefCount((Tcl_Obj *) runPtr->data[1]); runPtr->data[1] = NULL; corPtr->yieldPtr = NULL; break; @@ -9240,31 +9258,30 @@ TclNRCoroutineActivateCallback( } iPtr->execEnvPtr = corPtr->eePtr; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot yield: C stack busy", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", + (char *)NULL); + return TCL_ERROR; + } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot yield: C stack busy", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", - (char *)NULL); - return TCL_ERROR; - } - - void *type = data[1]; - if (type == CORO_ACTIVATE_YIELD) { - corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; - } else if (type == CORO_ACTIVATE_YIELDM) { - corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; - } else { - Tcl_Panic("Yield received an option which is not implemented"); - } + void *type = data[1]; + if (type == CORO_ACTIVATE_YIELD) { + corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; + } else if (type == CORO_ACTIVATE_YIELDM) { + corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; + } else { + Tcl_Panic("Yield received an option which is not implemented"); + } corPtr->yieldPtr = NULL; - corPtr->stackLevel = NULL; + corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return TCL_OK; @@ -9275,7 +9292,7 @@ TclNRCoroutineActivateCallback( * * TclNREvalList -- * - * Callback to invoke command as list, used in order to delayed + * Callback to invoke command as list, used in order to delayed * processing of canonical list command in sane environment. * *---------------------------------------------------------------------- @@ -9289,7 +9306,7 @@ TclNREvalList( { Tcl_Size objc; Tcl_Obj **objv; - Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *) data[0]; Tcl_IncrRefCount(listPtr); @@ -9304,7 +9321,7 @@ TclNREvalList( * * CoroTypeObjCmd -- * - * Implementation of [::tcl::unsupported::corotype] command. + * Implementation of [::tcl::unsupported::corotype] command. * *---------------------------------------------------------------------- */ @@ -9330,11 +9347,11 @@ CoroTypeObjCmd( cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only get coroutine type of a coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objv[1]), (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only get coroutine type of a coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objv[1]), (char *)NULL); + return TCL_ERROR; } /* @@ -9342,10 +9359,10 @@ CoroTypeObjCmd( * future. */ - corPtr = (CoroutineData *)cmdPtr->objClientData; + corPtr = (CoroutineData *) cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); + return TCL_OK; } /* @@ -9355,16 +9372,16 @@ CoroTypeObjCmd( switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); + return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); + return TCL_OK; default: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown coroutine type", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unknown coroutine type", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); + return TCL_ERROR; } } @@ -9373,7 +9390,7 @@ CoroTypeObjCmd( * * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd -- * - * Implementation of [coroinject] and [coroprobe] commands. + * Implementation of [coroinject] and [coroprobe] commands. * *---------------------------------------------------------------------- */ @@ -9391,12 +9408,12 @@ GetCoroutineFromObj( Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objPtr), (char *)NULL); - return NULL; + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objPtr), (char *) NULL); + return NULL; } - return (CoroutineData *)cmdPtr->objClientData; + return (CoroutineData *) cmdPtr->objClientData; } static int @@ -9419,15 +9436,15 @@ TclNRCoroInjectObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9438,7 +9455,7 @@ TclNRCoroInjectObjCmd( ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; @@ -9464,16 +9481,16 @@ TclNRCoroProbeObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a probe command into a coroutine"); + "can only inject a probe command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a probe command into a suspended coroutine", - -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a probe command into a suspended coroutine", + -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9484,7 +9501,7 @@ TclNRCoroProbeObjCmd( ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); iPtr->execEnvPtr = savedEEPtr; /* @@ -9495,7 +9512,7 @@ TclNRCoroProbeObjCmd( */ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); /* * Record the stackLevel at which the resume is happening, then swap @@ -9523,18 +9540,18 @@ TclNRCoroProbeObjCmd( * * InjectHandler, InjectHandlerPostProc -- * - * Part of the implementation of [coroinject] and [coroprobe]. These are - * run inside the context of the coroutine being injected/probed into. + * Part of the implementation of [coroinject] and [coroprobe]. These are + * run inside the context of the coroutine being injected/probed into. * - * InjectHandler runs a script (possibly adding arguments) in the context - * of the coroutine. The script is specified as a one-shot list (with - * reference count equal to 1) in data[1]. This function also arranges - * for InjectHandlerPostProc to be the part that runs after the script - * completes. + * InjectHandler runs a script (possibly adding arguments) in the context + * of the coroutine. The script is specified as a one-shot list (with + * reference count equal to 1) in data[1]. This function also arranges + * for InjectHandlerPostProc to be the part that runs after the script + * completes. * - * InjectHandlerPostProc cleans up after InjectHandler (deleting the - * list) and, for the [coroprobe] command *only*, yields back to the - * caller context (i.e., where [coroprobe] was run). + * InjectHandlerPostProc cleans up after InjectHandler (deleting the + * list) and, for the [coroprobe] command *only*, yields back to the + * caller context (i.e., where [coroprobe] was run). *s *---------------------------------------------------------------------- */ @@ -9545,8 +9562,8 @@ InjectHandler( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - CoroutineData *corPtr = (CoroutineData *)data[0]; - Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; + CoroutineData *corPtr = (CoroutineData *) data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *) data[1]; Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; Tcl_Size objc; @@ -9581,7 +9598,7 @@ InjectHandler( Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr, - INT2PTR(nargs), isProbe); + INT2PTR(nargs), isProbe); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } @@ -9592,8 +9609,8 @@ InjectHandlerPostCall( Tcl_Interp *interp, int result) { - CoroutineData *corPtr = (CoroutineData *)data[0]; - Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; + CoroutineData *corPtr = (CoroutineData *) data[0]; + Tcl_Obj *listPtr = (Tcl_Obj *) data[1]; Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; @@ -9611,16 +9628,16 @@ InjectHandlerPostCall( */ if (isProbe) { - if (result == TCL_ERROR) { - Tcl_AddErrorInfo(interp, - "\n (injected coroutine probe command)"); - } - corPtr->nargs = nargs; - corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + if (result == TCL_ERROR) { + Tcl_AddErrorInfo(interp, + "\n (injected coroutine probe command)"); + } + corPtr->nargs = nargs; + corPtr->stackLevel = NULL; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return result; } @@ -9630,7 +9647,7 @@ InjectHandlerPostCall( * * NRInjectObjCmd -- * - * Implementation of [::tcl::unsupported::inject] command. + * Implementation of [::tcl::unsupported::inject] command. * *---------------------------------------------------------------------- */ @@ -9656,15 +9673,15 @@ NRInjectObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", -1)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9673,8 +9690,8 @@ NRInjectObjCmd( */ iPtr->execEnvPtr = corPtr->eePtr; - TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2), - NULL, NULL, NULL); + TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc - 2, objv + 2), + NULL, NULL, NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; @@ -9687,12 +9704,12 @@ TclNRInterpCoroutine( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - CoroutineData *corPtr = (CoroutineData *)clientData; + CoroutineData *corPtr = (CoroutineData *) clientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "coroutine \"%s\" is already running", - TclGetString(objv[0]))); + "coroutine \"%s\" is already running", + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", (char *)NULL); return TCL_ERROR; } @@ -9705,31 +9722,31 @@ TclNRInterpCoroutine( switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - if (objc == 2) { - Tcl_SetObjResult(interp, objv[1]); - } else if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); - return TCL_ERROR; - } - break; + if (objc == 2) { + Tcl_SetObjResult(interp, objv[1]); + } else if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); + return TCL_ERROR; + } + break; default: - if (corPtr->nargs + 1 != objc) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong coro nargs; how did we get here? " - "not implemented!", -1)); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); - return TCL_ERROR; - } - /* fallthrough */ + if (corPtr->nargs + 1 != objc) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong coro nargs; how did we get here? " + "not implemented!", -1)); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); + return TCL_ERROR; + } + /* fallthrough */ case COROUTINE_ARGUMENTS_ARBITRARY: - if (objc > 1) { - Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); - } - break; + if (objc > 1) { + Tcl_SetObjResult(interp, Tcl_NewListObj(objc - 1, objv + 1)); + } + break; } TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } @@ -9738,8 +9755,8 @@ TclNRInterpCoroutine( * * TclNRCoroutineObjCmd -- * - * Implementation of [coroutine] command; see documentation for - * description of what this does. + * Implementation of [coroutine] command; see documentation for + * description of what this does. * *---------------------------------------------------------------------- */ @@ -9755,7 +9772,7 @@ TclNRCoroutineObjCmd( CoroutineData *corPtr; const char *procName, *simpleName; Namespace *nsPtr, *altNsPtr, *cxtNsPtr, - *inNsPtr = (Namespace *)TclGetCurrentNamespace(interp); + *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp); Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr; if (objc < 3) { @@ -9769,16 +9786,16 @@ TclNRCoroutineObjCmd( if (nsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": unknown namespace", - procName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); + "can't create procedure \"%s\": unknown namespace", + procName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); return TCL_ERROR; } if (simpleName == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": bad procedure name", - procName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); + "can't create procedure \"%s\": bad procedure name", + procName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); return TCL_ERROR; } @@ -9787,10 +9804,10 @@ TclNRCoroutineObjCmd( * struct and create the corresponding command. */ - corPtr = (CoroutineData *)Tcl_Alloc(sizeof(CoroutineData)); + corPtr = (CoroutineData *) Tcl_Alloc(sizeof(CoroutineData)); cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName, - (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, + (Tcl_Namespace *) nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine); corPtr->cmdPtr = cmdPtr; @@ -9809,7 +9826,8 @@ TclNRCoroutineObjCmd( Tcl_HashSearch hSearch; Tcl_HashEntry *hePtr; - corPtr->lineLABCPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); + corPtr->lineLABCPtr = (Tcl_HashTable *) + Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch); @@ -9870,7 +9888,7 @@ TclNRCoroutineObjCmd( */ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 329cfe2..d95452b 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -557,7 +557,6 @@ TclNarrowToBytes( Tcl_IncrRefCount(objPtr); return objPtr; } - /* *---------------------------------------------------------------------- diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 1c12106..a95fc83 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -719,7 +719,6 @@ Tcl_AttemptDbCkrealloc( Tcl_DbCkfree(ptr, file, line); return newPtr; } - /* *---------------------------------------------------------------------- @@ -1010,7 +1009,6 @@ Tcl_InitMemory( Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL); } - #else /* TCL_MEM_DEBUG */ /* This is the !TCL_MEM_DEBUG case */ @@ -1018,7 +1016,6 @@ Tcl_InitMemory( #undef Tcl_InitMemory #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory - /* *---------------------------------------------------------------------- @@ -1253,11 +1250,11 @@ TclDumpMemoryInfo( */ void * TclAllocElemsEx( - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored - here if non-NULL. Only modified on success */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if + * non-NULL. Only modified on success */ { void *ptr = TclAttemptReallocElemsEx( NULL, elemCount, elemSize, leadSize, capacityPtr); @@ -1288,13 +1285,13 @@ TclAllocElemsEx( */ void * TclAttemptReallocElemsEx( - void *oldPtr, /* Pointer to memory block to reallocate or - * NULL to indicate this is a new allocation */ - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored - here if non-NULL. Only modified on success */ + void *oldPtr, /* Pointer to memory block to reallocate or + * NULL to indicate this is a new allocation */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if + * non-NULL. Only modified on success */ { void *ptr; Tcl_Size limit; @@ -1358,12 +1355,12 @@ TclAttemptReallocElemsEx( */ void * TclReallocElemsEx( - void *oldPtr, /* Pointer to memory block to reallocate */ - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored - here if non-NULL. Only modified on success */ + void *oldPtr, /* Pointer to memory block to reallocate */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if + * non-NULL. Only modified on success */ { void *ptr = TclAttemptReallocElemsEx( oldPtr, elemCount, elemSize, leadSize, capacityPtr); diff --git a/generic/tclClock.c b/generic/tclClock.c index 2cfa4a5..412f616 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1964,7 +1964,6 @@ ConvertLocalToUTC( ltzoc->tzOffset = fields->tzOffset; } - /* check DST-hole: if retrieved seconds is out of range */ if (ltzoc->rangesVal[0] > seconds || seconds >= ltzoc->rangesVal[1]) { dstHole: @@ -2900,7 +2899,6 @@ GetJulianDayFromEraYearMonthDay( *---------------------------------------------------------------------- */ - void GetJulianDayFromEraYearDay( TclDateFields *fields, /* Date to convert */ @@ -4250,7 +4248,6 @@ ClockCalcRelTime( return TCL_OK; } - /*---------------------------------------------------------------------- * @@ -4309,8 +4306,6 @@ ClockWeekdaysOffs( return offs; } - - /*---------------------------------------------------------------------- * diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 288271b..ab5fbb0 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -425,14 +425,13 @@ TclInitEncodingCmd( */ static int EncodingConvertParseOptions( - Tcl_Interp *interp, /* For error messages. May be NULL */ - int objc, /* Number of arguments */ - Tcl_Obj *const objv[], /* Argument objects as passed to command. */ - Tcl_Encoding *encPtr, /* Where to store the encoding */ - Tcl_Obj **dataObjPtr, /* Where to store ptr to Tcl_Obj containing data */ - int *profilePtr, /* Bit mask of encoding option profile */ - Tcl_Obj **failVarPtr /* Where to store -failindex option value */ -) + Tcl_Interp *interp, /* For error messages. May be NULL */ + int objc, /* Number of arguments */ + Tcl_Obj *const objv[], /* Argument objects as passed to command. */ + Tcl_Encoding *encPtr, /* Where to store the encoding */ + Tcl_Obj **dataObjPtr, /* Where to store ptr to Tcl_Obj containing data */ + int *profilePtr, /* Bit mask of encoding option profile */ + Tcl_Obj **failVarPtr) /* Where to store -failindex option value */ { static const char *const options[] = {"-profile", "-failindex", NULL}; enum convertfromOptions { PROFILE, FAILINDEX } optIndex; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index c46ab60..37c9822 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -5290,7 +5290,6 @@ SortCompare( return 0; } - objPtr1 = elemPtr1->collationKey.objValuePtr; objPtr2 = elemPtr2->collationKey.objValuePtr; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 99a97ad..bad58f6 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -657,7 +657,6 @@ TclCompileCatchCmd( } ExceptionRangeEnds(envPtr, range); - /* * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result, * and jump around the "error case" code. @@ -679,7 +678,6 @@ TclCompileCatchCmd( TclEmitOpcode( INST_POP, envPtr); } - /* Stack at this point is empty */ TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); @@ -791,7 +789,6 @@ TclCompileClockClicksCmd( } return TCL_OK; } - /*---------------------------------------------------------------------- * @@ -2851,7 +2848,6 @@ CompileEachloopCmd( int varIndex; Tcl_Size length; - Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); bytes = TclGetStringFromObj(varNameObj, &length); varIndex = LocalScalar(bytes, length, envPtr); diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 98a39f9..bc37155 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -101,7 +101,6 @@ const AuxDataType tclJumptableInfoType = { if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));} #define INVOKE(name) \ TclEmitInvoke(envPtr,INST_##name) - /* *---------------------------------------------------------------------- diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index c9f9ec5..5c46afd 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -1924,7 +1924,7 @@ ParseLexeme( unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ Tcl_Obj **literalPtr) /* Write corresponding literal value to this - storage, if non-NULL. */ + * storage, if non-NULL. */ { const char *end; int ch; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 5bbbb8f..18d5ed7 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -89,20 +89,20 @@ typedef enum { typedef struct { ExceptionRangeType type; /* The kind of ExceptionRange. */ - Tcl_Size nestingLevel; /* Static depth of the exception range. Used + Tcl_Size nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range * surrounding a PC at runtime. */ - Tcl_Size codeOffset; /* Offset of the first instruction byte of the + Tcl_Size codeOffset; /* Offset of the first instruction byte of the * code range. */ - Tcl_Size numCodeBytes; /* Number of bytes in the code range. */ - Tcl_Size breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC + Tcl_Size numCodeBytes; /* Number of bytes in the code range. */ + Tcl_Size breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC * offset for a break command in the range. */ - Tcl_Size continueOffset; /* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, the - * target PC offset for a continue command in - * the code range. Otherwise, ignore this + Tcl_Size continueOffset; /* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, + * the target PC offset for a continue command + * in the code range. Otherwise, ignore this * range when processing a continue * command. */ - Tcl_Size catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC + Tcl_Size catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC * offset for any "exception" in range. */ } ExceptionRange; @@ -118,11 +118,11 @@ typedef struct ExceptionAux { * one (see [for] next-clause) then we must * not pick up the range when scanning for a * target to continue to. */ - Tcl_Size stackDepth; /* The stack depth at the point where the + Tcl_Size stackDepth; /* The stack depth at the point where the * exception range was created. This is used * to calculate the number of POPs required to * restore the stack to its prior state. */ - Tcl_Size expandTarget; /* The number of expansions expected on the + Tcl_Size expandTarget; /* The number of expansions expected on the * auxData stack at the time the loop starts; * we can't currently discard them except by * doing INST_INVOKE_EXPANDED; this is a known @@ -135,23 +135,25 @@ typedef struct ExceptionAux { Tcl_Size numBreakTargets; /* The number of [break]s that want to be * targeted to the place where this loop * exception will be bound to. */ - TCL_HASH_TYPE *breakTargets; /* The offsets of the INST_JUMP4 instructions + TCL_HASH_TYPE *breakTargets;/* The offsets of the INST_JUMP4 instructions * issued by the [break]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numBreakTargets==0, this is NULL. */ Tcl_Size allocBreakTargets; /* The size of the breakTargets array. */ - Tcl_Size numContinueTargets; /* The number of [continue]s that want to be + Tcl_Size numContinueTargets;/* The number of [continue]s that want to be * targeted to the place where this loop * exception will be bound to. */ - TCL_HASH_TYPE *continueTargets; /* The offsets of the INST_JUMP4 instructions + TCL_HASH_TYPE *continueTargets; + /* The offsets of the INST_JUMP4 instructions * issued by the [continue]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numContinueTargets==0, this is NULL. */ - Tcl_Size allocContinueTargets; /* The size of the continueTargets array. */ + Tcl_Size allocContinueTargets; + /* The size of the continueTargets array. */ } ExceptionAux; /* @@ -163,10 +165,10 @@ typedef struct ExceptionAux { */ typedef struct { - Tcl_Size codeOffset; /* Offset of first byte of command code. */ - Tcl_Size numCodeBytes; /* Number of bytes for command's code. */ + Tcl_Size codeOffset; /* Offset of first byte of command code. */ + Tcl_Size numCodeBytes; /* Number of bytes for command's code. */ Tcl_Size srcOffset; /* Offset of first char of the command. */ - Tcl_Size numSrcBytes; /* Number of command source chars. */ + Tcl_Size numSrcBytes; /* Number of command source chars. */ } CmdLocation; /* @@ -182,10 +184,10 @@ typedef struct { typedef struct { Tcl_Size srcOffset; /* Command location to find the entry. */ - Tcl_Size nline; /* Number of words in the command */ - Tcl_Size *line; /* Line information for all words in the + Tcl_Size nline; /* Number of words in the command */ + Tcl_Size *line; /* Line information for all words in the * command. */ - Tcl_Size **next; /* Transient information used by the compiler + Tcl_Size **next; /* Transient information used by the compiler * for tracking of hidden continuation * lines. */ } ECL; @@ -198,8 +200,8 @@ typedef struct { Tcl_Obj *path; /* Path of the sourced file the command is * in. */ ECL *loc; /* Command word locations (lines). */ - Tcl_Size nloc; /* Number of allocated entries in 'loc'. */ - Tcl_Size nuloc; /* Number of used entries in 'loc'. */ + Tcl_Size nloc; /* Number of allocated entries in 'loc'. */ + Tcl_Size nuloc; /* Number of used entries in 'loc'. */ } ExtCmdLoc; /* @@ -217,11 +219,11 @@ typedef struct { * the AuxData structure. */ -typedef void *(AuxDataDupProc) (void *clientData); -typedef void (AuxDataFreeProc) (void *clientData); -typedef void (AuxDataPrintProc)(void *clientData, - Tcl_Obj *appendObj, struct ByteCode *codePtr, - TCL_HASH_TYPE pcOffset); +typedef void * (AuxDataDupProc) (void *clientData); +typedef void (AuxDataFreeProc) (void *clientData); +typedef void (AuxDataPrintProc) (void *clientData, + Tcl_Obj *appendObj, struct ByteCode *codePtr, + TCL_HASH_TYPE pcOffset); /* * We define a separate AuxDataType struct to hold type-related information @@ -266,7 +268,7 @@ typedef struct AuxDataType { typedef struct AuxData { const AuxDataType *type; /* Pointer to the AuxData type associated with * this ClientData. */ - void *clientData; /* The compilation data itself. */ + void *clientData; /* The compilation data itself. */ } AuxData; /* @@ -290,21 +292,23 @@ typedef struct CompileEnv { * SetByteCodeFromAny. This pointer is not * owned by the CompileEnv and must not be * freed or changed by it. */ - Tcl_Size numSrcBytes; /* Number of bytes in source. */ + Tcl_Size numSrcBytes; /* Number of bytes in source. */ Proc *procPtr; /* If a procedure is being compiled, a pointer * to its Proc structure; otherwise NULL. Used * to compile local variables. Set from * information provided by ObjInterpProc in * tclProc.c. */ - Tcl_Size numCommands; /* Number of commands compiled. */ - Tcl_Size exceptDepth; /* Current exception range nesting level; TCL_INDEX_NONE - * if not in any range currently. */ - Tcl_Size maxExceptDepth; /* Max nesting level of exception ranges; TCL_INDEX_NONE - * if no ranges have been compiled. */ - Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to + Tcl_Size numCommands; /* Number of commands compiled. */ + Tcl_Size exceptDepth; /* Current exception range nesting level; + * TCL_INDEX_NONE if not in any range + * currently. */ + Tcl_Size maxExceptDepth; /* Max nesting level of exception ranges; + * TCL_INDEX_NONE if no ranges have been + * compiled. */ + Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to * execute the code. Set by compilation * procedures before returning. */ - Tcl_Size currStackDepth; /* Current stack depth. */ + Tcl_Size currStackDepth; /* Current stack depth. */ LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl * objects referenced by this compiled code. * Indexed by the string representations of @@ -333,7 +337,7 @@ typedef struct CompileEnv { * exceptArrayNext is the number of ranges and * (exceptArrayNext-1) is the index of the * current range's array entry. */ - Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array + Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array * entry. */ #if TCL_MAJOR_VERSION < 9 int mallocedExceptArray; @@ -379,7 +383,7 @@ typedef struct CompileEnv { /* TIP #280 */ ExtCmdLoc *extCmdMapPtr; /* Extended command location information for * 'info frame'. */ - Tcl_Size line; /* First line of the script, based on the + Tcl_Size line; /* First line of the script, based on the * invoking context, then the line of the * command currently compiled. */ int atCmdStart; /* Flag to say whether an INST_START_CMD @@ -388,11 +392,11 @@ typedef struct CompileEnv { * inefficient. If set to 2, that instruction * should not be issued at all (by the generic * part of the command compiler). */ - Tcl_Size expandCount; /* Number of INST_EXPAND_START instructions + Tcl_Size expandCount; /* Number of INST_EXPAND_START instructions * encountered that have not yet been paired * with a corresponding * INST_INVOKE_EXPANDED. */ - Tcl_Size *clNext; /* If not NULL, it refers to the next slot in + Tcl_Size *clNext; /* If not NULL, it refers to the next slot in * clLoc to check for an invisible * continuation line. */ } CompileEnv; @@ -427,7 +431,7 @@ typedef struct ByteCode { * procs are specific to an interpreter so the * code emitted will depend on the * interpreter. */ - Tcl_Size compileEpoch; /* Value of iPtr->compileEpoch when this + Tcl_Size compileEpoch; /* Value of iPtr->compileEpoch when this * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ @@ -459,17 +463,17 @@ typedef struct ByteCode { * itself. Does not include heap space for * literal Tcl objects or storage referenced * by AuxData entries. */ - Tcl_Size numCommands; /* Number of commands compiled. */ - Tcl_Size numSrcBytes; /* Number of source bytes compiled. */ - Tcl_Size numCodeBytes; /* Number of code bytes. */ - Tcl_Size numLitObjects; /* Number of objects in literal array. */ + Tcl_Size numCommands; /* Number of commands compiled. */ + Tcl_Size numSrcBytes; /* Number of source bytes compiled. */ + Tcl_Size numCodeBytes; /* Number of code bytes. */ + Tcl_Size numLitObjects; /* Number of objects in literal array. */ Tcl_Size numExceptRanges; /* Number of ExceptionRange array elems. */ Tcl_Size numAuxDataItems; /* Number of AuxData items. */ - Tcl_Size numCmdLocBytes; /* Number of bytes needed for encoded command + Tcl_Size numCmdLocBytes; /* Number of bytes needed for encoded command * location information. */ - Tcl_Size maxExceptDepth; /* Maximum nesting level of ExceptionRanges; + Tcl_Size maxExceptDepth; /* Maximum nesting level of ExceptionRanges; * TCL_INDEX_NONE if no ranges were compiled. */ - Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to + Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to * execute the code. */ unsigned char *codeStart; /* Points to the first byte of the code. This * is just after the final ByteCode member @@ -525,7 +529,7 @@ typedef struct ByteCode { #endif /* TCL_COMPILE_STATS */ } ByteCode; -#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr) \ +#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (codePtr); \ @@ -533,13 +537,11 @@ typedef struct ByteCode { Tcl_StoreInternalRep((objPtr), (typePtr), &ir); \ } while (0) - - -#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \ +#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), (typePtr)); \ - (codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), (typePtr)); \ + (codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -829,11 +831,11 @@ enum TclInstruction { INST_DICT_GET_DEF, - /* TIP 461 */ - INST_STR_LT, - INST_STR_GT, - INST_STR_LE, - INST_STR_GE, + /* TIP 461 */ + INST_STR_LT, + INST_STR_GT, + INST_STR_LE, + INST_STR_GE, INST_LREPLACE4, @@ -968,8 +970,8 @@ typedef struct JumpFixup { typedef struct JumpFixupArray { JumpFixup *fixup; /* Points to start of jump fixup array. */ - Tcl_Size next; /* Index of next free array entry. */ - Tcl_Size end; /* Index of last usable entry in array. */ + Tcl_Size next; /* Index of next free array entry. */ + Tcl_Size end; /* Index of last usable entry in array. */ int mallocedArray; /* 1 if array was expanded and fixups points * into the heap, else 0. */ JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES]; @@ -985,7 +987,8 @@ typedef struct JumpFixupArray { typedef struct ForeachVarList { Tcl_Size numVars; /* The number of variables in the list. */ - Tcl_Size varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers") + Tcl_Size varIndexes[TCLFLEXARRAY]; + /* An array of the indexes ("slot numbers") * for each variable in the procedure's array * of local variables. Only scalar variables * are supported. The actual size of this @@ -1003,13 +1006,14 @@ typedef struct ForeachVarList { typedef struct ForeachInfo { Tcl_Size numLists; /* The number of both the variable and value * lists of the foreach command. */ - Tcl_Size firstValueTemp; /* Index of the first temp var in a proc frame + Tcl_Size firstValueTemp; /* Index of the first temp var in a proc frame * used to point to a value list. */ - Tcl_Size loopCtTemp; /* Index of temp var in a proc frame holding + Tcl_Size loopCtTemp; /* Index of temp var in a proc frame holding * the loop's iteration count. Used to * determine next value list element to assign * each loop var. */ - ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList + ForeachVarList *varLists[TCLFLEXARRAY]; + /* An array of pointers to ForeachVarList * structures describing each var list. The * actual size of this field will be large * enough to numVars indexes. THIS MUST BE THE @@ -1040,7 +1044,8 @@ MODULE_SCOPE const AuxDataType tclJumptableInfoType; typedef struct { Tcl_Size length; /* Size of array */ - Tcl_Size varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when + Tcl_Size varIndices[TCLFLEXARRAY]; + /* Array of variable indices to manage when * processing the start and end of a [dict * update]. There is really more than one * entry, and the structure is allocated to @@ -1200,14 +1205,13 @@ MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, Tcl_Size length, const unsigned char *pc, Tcl_Obj **tosPtr); -MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, +MODULE_SCOPE Tcl_Obj * TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); -MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); +MODULE_SCOPE Tcl_Obj * TclNewInstNameObj(unsigned char inst); MODULE_SCOPE int TclPushProcCallFrame(void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int isLambda); #endif /* TCL_MAJOR_VERSION > 8 */ - /* *---------------------------------------------------------------- @@ -1230,58 +1234,66 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, #define LITERAL_UNSHARED 0x04 /* - * Macro used to manually adjust the stack requirements; used in cases where - * the stack effect cannot be computed from the opcode and its operands, but - * is still known at compile time. - * - * void TclAdjustStackDepth(int delta, CompileEnv *envPtr); + * Adjust the stack requirements. Manually used in cases where the stack + * effect cannot be computed from the opcode and its operands, but is still + * known at compile time. */ +static inline void +TclAdjustStackDepth( + int delta, + CompileEnv *envPtr) +{ + if (delta < 0) { + if ((int) envPtr->maxStackDepth < (int) envPtr->currStackDepth) { + envPtr->maxStackDepth = envPtr->currStackDepth; + } + } + envPtr->currStackDepth += delta; +} -#define TclAdjustStackDepth(delta, envPtr) \ - do { \ - if ((delta) < 0) { \ - if ((int)(envPtr)->maxStackDepth < (int)(envPtr)->currStackDepth) { \ - (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \ - } \ - } \ - (envPtr)->currStackDepth += (delta); \ - } while (0) - -#define TclGetStackDepth(envPtr) \ +#define TclGetStackDepth(envPtr) \ ((envPtr)->currStackDepth) -#define TclSetStackDepth(depth, envPtr) \ +#define TclSetStackDepth(depth, envPtr) \ (envPtr)->currStackDepth = (depth) -#define TclCheckStackDepth(depth, envPtr) \ - do { \ - size_t _dd = (depth); \ - if (_dd != (size_t)(envPtr)->currStackDepth) { \ - Tcl_Panic("bad stack depth computations: is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u", \ - (size_t)(envPtr)->currStackDepth, _dd); \ - } \ - } while (0) +/* + * Verify that the current stack depth is what we think it should be. When + * this is wrong, code generation is broken! + */ +static inline void +TclCheckStackDepth( + size_t depth, + CompileEnv *envPtr) +{ + if (depth != (size_t) envPtr->currStackDepth) { + Tcl_Panic("bad stack depth computations: " + "is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u", + (size_t) envPtr->currStackDepth, depth); + } +} /* - * Macro used to update the stack requirements. It is called by the macros - * TclEmitOpCode, TclEmitInst1 and TclEmitInst4. + * Update the stack requirements based on the instruction definition. It is + * called by the macros TclEmitOpCode, TclEmitInst1 and TclEmitInst4. * Remark that the very last instruction of a bytecode always reduces the * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always * updated. - * - * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr); */ - -#define TclUpdateStackReqs(op, i, envPtr) \ - do { \ - int _delta = tclInstructionTable[(op)].stackEffect; \ - if (_delta) { \ - if (_delta == INT_MIN) { \ - _delta = 1 - (i); \ - } \ - TclAdjustStackDepth(_delta, envPtr); \ - } \ - } while (0) +static inline void +TclUpdateStackReqs( + unsigned char op, + int i, + CompileEnv *envPtr) +{ + int delta = tclInstructionTable[op].stackEffect; + if (delta) { + if (delta == INT_MIN) { + delta = 1 - i; + } + TclAdjustStackDepth(delta, envPtr); + } +} /* * Macros used to update the flag that indicates if we are at the start of a @@ -1291,8 +1303,8 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclUpdateAtCmdStart(op, envPtr) \ - if ((envPtr)->atCmdStart < 2) { \ - (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \ + if ((envPtr)->atCmdStart < 2) { \ + (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \ } /* @@ -1303,13 +1315,13 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclEmitOpcode(op, envPtr) \ - do { \ - if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - TclUpdateAtCmdStart(op, envPtr); \ - TclUpdateStackReqs(op, 0, envPtr); \ + do { \ + if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op); \ + TclUpdateAtCmdStart(op, envPtr); \ + TclUpdateStackReqs(op, 0, envPtr); \ } while (0) /* @@ -1365,21 +1377,21 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, } while (0) #define TclEmitInstInt4(op, i, envPtr) \ - do { \ - if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 24); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 16); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 8); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) ); \ - TclUpdateAtCmdStart(op, envPtr); \ - TclUpdateStackReqs(op, i, envPtr); \ + do { \ + if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 24); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 16); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 8); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) ); \ + TclUpdateAtCmdStart(op, envPtr); \ + TclUpdateStackReqs(op, i, envPtr); \ } while (0) /* @@ -1392,13 +1404,13 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclEmitPush(objIndex, envPtr) \ - do { \ - int _objIndexCopy = (objIndex); \ - if (_objIndexCopy <= 255) { \ - TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ - } else { \ - TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ - } \ + do { \ + int _objIndexCopy = (objIndex); \ + if (_objIndexCopy <= 255) { \ + TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ + } else { \ + TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ + } \ } while (0) /* @@ -1414,11 +1426,11 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, *(p) = (unsigned char) ((unsigned int) (i)) #define TclStoreInt4AtPtr(i, p) \ - do { \ - *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ - *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ - *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ - *(p+3) = (unsigned char) ((unsigned int) (i) ); \ + do { \ + *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ + *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ + *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ + *(p+3) = (unsigned char) ((unsigned int) (i) ); \ } while (0) /* @@ -1431,15 +1443,15 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclUpdateInstInt1AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt1AtPtr((i), ((pc)+1)); \ + do { \ + *(pc) = (unsigned char) (op); \ + TclStoreInt1AtPtr((i), ((pc)+1)); \ } while (0) #define TclUpdateInstInt4AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt4AtPtr((i), ((pc)+1)); \ + do { \ + *(pc) = (unsigned char) (op); \ + TclStoreInt4AtPtr((i), ((pc)+1)); \ } while (0) /* @@ -1486,17 +1498,17 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, #endif #define TclGetInt4AtPtr(p) \ - ((int) ((TclGetUInt1AtPtr(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ + ((int) ((TclGetUInt1AtPtr(p) << 24) | \ + (*((p)+1) << 16) | \ + (*((p)+2) << 8) | \ (*((p)+3)))) #define TclGetUInt1AtPtr(p) \ ((unsigned int) *(p)) #define TclGetUInt4AtPtr(p) \ - ((unsigned int) ((*(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ + ((unsigned int) ((*(p) << 24) | \ + (*((p)+1) << 16) | \ + (*((p)+2) << 8) | \ (*((p)+3)))) /* @@ -1517,7 +1529,7 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, * static void BODY(Tcl_Token *tokenPtr, int word); */ -#define BODY(tokenPtr, word) \ +#define BODY(tokenPtr, word) \ SetLineInformation((word)); \ TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \ envPtr) @@ -1815,14 +1827,14 @@ MODULE_SCOPE void TclDTraceOpenDebugLog(void); MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *argsi); #define TCL_DTRACE_DEBUG_LOG() \ - int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \ - int tclDTraceDebugIndent = 0; \ - FILE *tclDTraceDebugLog = NULL; \ - void TclDTraceOpenDebugLog(void) { \ - char n[35]; \ + int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \ + int tclDTraceDebugIndent = 0; \ + FILE *tclDTraceDebugLog = NULL; \ + void TclDTraceOpenDebugLog(void) { \ + char n[35]; \ snprintf(n, sizeof(n), "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \ - (size_t) getpid()); \ - tclDTraceDebugLog = fopen(n, "a"); \ + (size_t) getpid()); \ + tclDTraceDebugLog = fopen(n, "a"); \ } #define TclDTraceDbgMsg(p, m, ...) \ @@ -1849,10 +1861,10 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *args #define TCL_DTRACE_PROC_ARGS_ENABLED() 1 #define TCL_DTRACE_PROC_INFO_ENABLED() 1 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \ - tclDTraceDebugIndent++; \ + tclDTraceDebugIndent++; \ TclDTraceDbgMsg("-> proc-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2) #define TCL_DTRACE_PROC_RETURN(a0, a1) \ - TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ + TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \ TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3) @@ -1869,10 +1881,10 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *args #define TCL_DTRACE_CMD_ARGS_ENABLED() 1 #define TCL_DTRACE_CMD_INFO_ENABLED() 1 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \ - tclDTraceDebugIndent++; \ + tclDTraceDebugIndent++; \ TclDTraceDbgMsg("-> cmd-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2) #define TCL_DTRACE_CMD_RETURN(a0, a1) \ - TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ + TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \ TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3) diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 7a8783c..5a64ff8 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -45,21 +45,20 @@ static const Tcl_ObjType instNameType = { TCL_OBJTYPE_V0 }; -#define InstNameSetInternalRep(objPtr, inst) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.wideValue = (inst); \ +#define InstNameSetInternalRep(objPtr, inst) \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.wideValue = (inst); \ Tcl_StoreInternalRep((objPtr), &instNameType, &ir); \ } while (0) -#define InstNameGetInternalRep(objPtr, inst) \ - do { \ +#define InstNameGetInternalRep(objPtr, inst) \ + do { \ const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &instNameType); \ - assert(irPtr != NULL); \ - (inst) = irPtr->wideValue; \ + irPtr = TclFetchInternalRep((objPtr), &instNameType); \ + assert(irPtr != NULL); \ + (inst) = irPtr->wideValue; \ } while (0) - /* *---------------------------------------------------------------------- diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 4b1ef16..0844303 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -258,7 +258,6 @@ static Tcl_EncodingConvertProc UtfToUtfProc; static Tcl_EncodingConvertProc Iso88591FromUtfProc; static Tcl_EncodingConvertProc Iso88591ToUtfProc; - /* * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field * of the internalrep. This should help the lifetime of encodings be more useful. @@ -274,21 +273,20 @@ static const Tcl_ObjType encodingType = { TCL_OBJTYPE_V0 }; -#define EncodingSetInternalRep(objPtr, encoding) \ +#define EncodingSetInternalRep(objPtr, encoding) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (encoding); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \ + Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \ } while (0) -#define EncodingGetInternalRep(objPtr, encoding) \ +#define EncodingGetInternalRep(objPtr, encoding) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep ((objPtr), &encodingType); \ - (encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \ + (encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) - /* *---------------------------------------------------------------------- @@ -1112,7 +1110,6 @@ Tcl_ExternalToUtfDString( NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL); return Tcl_DStringValue(dstPtr); } - /* *------------------------------------------------------------------------- @@ -1158,14 +1155,14 @@ Tcl_ExternalToUtfDStringEx( Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - Tcl_Size srcLen, /* Source string length in bytes, or < 0 for + Tcl_Size srcLen, /* Source string length in bytes, or < 0 for * encoding-specific string length. */ int flags, /* Conversion control flags. */ Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ Tcl_Size *errorLocPtr) /* Where to store the error location - (or TCL_INDEX_NONE if no error). May - be NULL. */ + * (or TCL_INDEX_NONE if no error). May + * be NULL. */ { char *dst; Tcl_EncodingState state; @@ -1430,7 +1427,6 @@ Tcl_UtfToExternalDString( NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL); return Tcl_DStringValue(dstPtr); } - /* *------------------------------------------------------------------------- @@ -1481,8 +1477,8 @@ Tcl_UtfToExternalDStringEx( Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ Tcl_Size *errorLocPtr) /* Where to store the error location - (or TCL_INDEX_NONE if no error). May - be NULL. */ + * (or TCL_INDEX_NONE if no error). May + * be NULL. */ { char *dst; Tcl_EncodingState state; diff --git a/generic/tclEnv.c b/generic/tclEnv.c index ef4e946..0128672 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -20,9 +20,9 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #if defined(_WIN32) # define tenviron _wenviron # define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ - (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr))) + (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr))) # define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ - (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr))) + (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr))) # define techar WCHAR # ifdef USE_PUTENV # define putenv(env) _wputenv((const wchar_t *)env) @@ -30,13 +30,12 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #else # define tenviron environ # define tenviron2utfdstr(str, dsPtr) \ - Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr) + Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr) # define utf2tenvirondstr(str, dsPtr) \ - Tcl_UtfToExternalDString(NULL, str, -1, dsPtr) + Tcl_UtfToExternalDString(NULL, str, -1, dsPtr) # define techar char #endif - /* MODULE_SCOPE */ size_t TclEnvEpoch = 0; /* Epoch of the tcl environment * (if changed with tcl-env). */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 334cfae..29d8a0c 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -893,7 +893,6 @@ Tcl_SetExitProc( return prevExitProc; } - /* *---------------------------------------------------------------------- @@ -935,7 +934,6 @@ InvokeExitHandlers(void) firstExitPtr = NULL; Tcl_MutexUnlock(&exitMutex); } - /* *---------------------------------------------------------------------- diff --git a/generic/tclExecute.c b/generic/tclExecute.c index bd502e8..79bfb11 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -192,7 +192,7 @@ VarHashCreateVar( /* Verify the stack depth, only when no expansion is in progress */ #ifdef TCL_COMPILE_DEBUG -#define CHECK_STACK() \ +#define CHECK_STACK() \ do { \ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \ /*checkStack*/ !(starting || auxObjList)); \ @@ -202,53 +202,53 @@ VarHashCreateVar( #define CHECK_STACK() #endif -#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ - do { \ - TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \ - CHECK_STACK(); \ - if (nCleanup == 0) { \ - if (resultHandling != 0) { \ - if ((resultHandling) > 0) { \ - PUSH_OBJECT(objResultPtr); \ - } else { \ - *(++tosPtr) = objResultPtr; \ - } \ - } \ - pc += (pcAdjustment); \ - goto cleanup0; \ - } else if (resultHandling != 0) { \ - if ((resultHandling) > 0) { \ - Tcl_IncrRefCount(objResultPtr); \ - } \ - pc += (pcAdjustment); \ - switch (nCleanup) { \ - case 1: goto cleanup1_pushObjResultPtr; \ - case 2: goto cleanup2_pushObjResultPtr; \ - case 0: break; \ - } \ - } else { \ - pc += (pcAdjustment); \ - switch (nCleanup) { \ - case 1: goto cleanup1; \ - case 2: goto cleanup2; \ - case 0: break; \ - } \ - } \ +#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ + do { \ + TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \ + CHECK_STACK(); \ + if (nCleanup == 0) { \ + if (resultHandling != 0) { \ + if ((resultHandling) > 0) { \ + PUSH_OBJECT(objResultPtr); \ + } else { \ + *(++tosPtr) = objResultPtr; \ + } \ + } \ + pc += (pcAdjustment); \ + goto cleanup0; \ + } else if (resultHandling != 0) { \ + if ((resultHandling) > 0) { \ + Tcl_IncrRefCount(objResultPtr); \ + } \ + pc += (pcAdjustment); \ + switch (nCleanup) { \ + case 1: goto cleanup1_pushObjResultPtr; \ + case 2: goto cleanup2_pushObjResultPtr; \ + case 0: break; \ + } \ + } else { \ + pc += (pcAdjustment); \ + switch (nCleanup) { \ + case 1: goto cleanup1; \ + case 2: goto cleanup2; \ + case 0: break; \ + } \ + } \ } while (0) -#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ - CHECK_STACK(); \ - do { \ - pc += (pcAdjustment); \ - cleanup = (nCleanup); \ - if (resultHandling) { \ - if ((resultHandling) > 0) { \ - Tcl_IncrRefCount(objResultPtr); \ - } \ - goto cleanupV_pushObjResultPtr; \ - } else { \ - goto cleanupV; \ - } \ +#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ + CHECK_STACK(); \ + do { \ + pc += (pcAdjustment); \ + cleanup = (nCleanup); \ + if (resultHandling) { \ + if ((resultHandling) > 0) { \ + Tcl_IncrRefCount(objResultPtr); \ + } \ + goto cleanupV_pushObjResultPtr; \ + } else { \ + goto cleanupV; \ + } \ } while (0) #ifndef TCL_COMPILE_DEBUG @@ -258,16 +258,16 @@ VarHashCreateVar( switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ - break; \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ @@ -275,7 +275,7 @@ VarHashCreateVar( objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_F(0, (cleanup), 1); \ - break; \ + break; \ } \ } while (0) #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ @@ -284,16 +284,16 @@ VarHashCreateVar( switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ - break; \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ @@ -301,7 +301,7 @@ VarHashCreateVar( objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_V(0, (cleanup), 1); \ - break; \ + break; \ } \ } while (0) #else /* TCL_COMPILE_DEBUG */ @@ -377,13 +377,14 @@ VarHashCreateVar( #ifdef TCL_COMPILE_DEBUG # define TRACE(a) \ - while (traceInstructions) { \ - fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ - GetOpcodeName(pc)); \ - printf a; \ - break; \ + while (traceInstructions) { \ + fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER \ + "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ + CURR_DEPTH, \ + (pc - codePtr->codeStart), \ + GetOpcodeName(pc)); \ + printf a; \ + break; \ } # define TRACE_APPEND(a) \ while (traceInstructions) { \ @@ -393,15 +394,16 @@ VarHashCreateVar( # define TRACE_ERROR(interp) \ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); # define TRACE_WITH_OBJ(a, objPtr) \ - while (traceInstructions) { \ - fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ - GetOpcodeName(pc)); \ - printf a; \ - TclPrintObject(stdout, objPtr, 30); \ - fprintf(stdout, "\n"); \ - break; \ + while (traceInstructions) { \ + fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER \ + "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ + CURR_DEPTH, \ + (pc - codePtr->codeStart), \ + GetOpcodeName(pc)); \ + printf a; \ + TclPrintObject(stdout, objPtr, 30); \ + fprintf(stdout, "\n"); \ + break; \ } # define O2S(objPtr) \ (objPtr ? TclGetString(objPtr) : "") @@ -475,7 +477,8 @@ VarHashCreateVar( * usage in [incr]: do the first summand and the sum have != signs? */ -#define Overflowing(a,b,sum) ((((a)^(sum)) < 0) && (((a)^(b)) >= 0)) +#define Overflowing(a,b,sum) \ + ((((a)^(sum)) < 0) && (((a)^(b)) >= 0)) /* * Macro for checking whether the type is NaN, used when we're thinking about @@ -1024,7 +1027,6 @@ GrowEvaluationStack( } needed = growth + moveWords + WALLOCALIGN; - /* * Check if there is enough room in the next stack (if there is one, it * should be both empty and the last one!) @@ -1407,8 +1409,7 @@ CompileExprObj( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - ByteCode *codePtr = NULL; - /* Tcl Internal type of bytecode. Initialized + ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ /* @@ -1563,7 +1564,7 @@ TclCompileObj( int word) { Interp *iPtr = (Interp *) interp; - ByteCode *codePtr; /* Tcl Internal type of bytecode. */ + ByteCode *codePtr; /* Tcl Internal type of bytecode. */ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; /* @@ -2027,8 +2028,8 @@ TEBCresume( Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ const unsigned char *pc = (const unsigned char *)data[1]; - /* The current program counter. */ - unsigned char inst; /* The currently running instruction */ + /* The current program counter. */ + unsigned char inst; /* The currently running instruction */ /* * Transfer variables - needed only between opcodes, but not while @@ -2037,7 +2038,7 @@ TEBCresume( int cleanup = PTR2INT(data[2]); Tcl_Obj *objResultPtr; - int checkInterp = 0; /* Indicates when a check of interp readyness + int checkInterp = 0; /* Indicates when a check of interp readyness * is necessary. Set by CACHE_STACK_INFO() */ /* @@ -2091,7 +2092,7 @@ TEBCresume( goto cleanup0; } else { - /* resume from invocation */ + /* resume from invocation */ CACHE_STACK_INFO(); NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); @@ -2581,14 +2582,15 @@ TEBCresume( case INST_REVERSE: { Tcl_Obj **a, **b; - opnd = TclGetUInt4AtPtr(pc+1); - a = tosPtr-(opnd-1); + opnd = TclGetUInt4AtPtr(pc + 1); + a = tosPtr - (opnd - 1); b = tosPtr; - while (a OK\n", opnd)); NEXT_INST_F(5, 0, 0); @@ -2619,7 +2621,7 @@ TEBCresume( */ opnd = TclGetUInt4AtPtr(pc+1); - objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); + objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd - 1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); break; @@ -3182,7 +3184,7 @@ TEBCresume( O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr))); } #endif - varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG, + varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (!varPtr) { TRACE_ERROR(interp); @@ -3773,7 +3775,7 @@ TEBCresume( if (varPtr) { if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) { DECACHE_STACK_INFO(); - TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr, + TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, part2Ptr, TCL_TRACE_READS, 0, -1); CACHE_STACK_INFO(); } @@ -4697,7 +4699,7 @@ TEBCresume( } /* - * End of TclOO support instructions. + * End of TclOO support instructions. * ----------------------------------------------------------------- * Start of INST_LIST and related instructions. */ @@ -4734,7 +4736,7 @@ TEBCresume( TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); /* special case for AbstractList */ - if (TclObjTypeHasProc(valuePtr,indexProc)) { + if (TclObjTypeHasProc(valuePtr, indexProc)) { DECACHE_STACK_INFO(); length = TclObjTypeLength(valuePtr); if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) { @@ -4825,7 +4827,7 @@ TEBCresume( */ /* special case for AbstractList */ - if (TclObjTypeHasProc(valuePtr,indexProc)) { + if (TclObjTypeHasProc(valuePtr, indexProc)) { length = TclObjTypeLength(valuePtr); /* Decode end-offset index values. */ @@ -4924,11 +4926,11 @@ TEBCresume( DECACHE_STACK_INFO(); if (TclObjTypeHasProc(valuePtr, setElementProc)) { objResultPtr = TclObjTypeSetElement(interp, - valuePtr, numIndices, - &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); + valuePtr, numIndices, + &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } else { objResultPtr = TclLsetFlat(interp, valuePtr, numIndices, - &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); + &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } if (!objResultPtr) { CACHE_STACK_INFO(); @@ -5074,60 +5076,60 @@ TEBCresume( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - s1 = TclGetStringFromObj(valuePtr, &s1len); - TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); - - if (TclObjTypeHasProc(value2Ptr,inOperProc) != NULL) { - int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match); - if (status != TCL_OK) { - TRACE_ERROR(interp); - goto gotError; - } - } else { - - if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { - TRACE_ERROR(interp); - goto gotError; - } - match = 0; - if (length > 0) { - Tcl_Size i = 0; - Tcl_Obj *o; - int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL; - - /* - * An empty list doesn't match anything. - */ - - do { - if (isAbstractList) { - DECACHE_STACK_INFO(); - if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) { - CACHE_STACK_INFO(); - TRACE_ERROR(interp); - goto gotError; - } - CACHE_STACK_INFO(); - } else { - Tcl_ListObjIndex(NULL, value2Ptr, i, &o); - } - if (o != NULL) { - s2 = TclGetStringFromObj(o, &s2len); - } else { - s2 = ""; - s2len = 0; - } - if (s1len == s2len) { - match = (memcmp(s1, s2, s1len) == 0); - } - - /* Could be an ephemeral abstract obj */ - Tcl_BounceRefCount(o); - - i++; - } while (i < length && match == 0); - } - } + s1 = TclGetStringFromObj(valuePtr, &s1len); + TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); + + if (TclObjTypeHasProc(value2Ptr, inOperProc) != NULL) { + int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match); + if (status != TCL_OK) { + TRACE_ERROR(interp); + goto gotError; + } + } else { + + if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { + TRACE_ERROR(interp); + goto gotError; + } + match = 0; + if (length > 0) { + Tcl_Size i = 0; + Tcl_Obj *o; + int isAbstractList = TclObjTypeHasProc(value2Ptr, indexProc) != NULL; + + /* + * An empty list doesn't match anything. + */ + + do { + if (isAbstractList) { + DECACHE_STACK_INFO(); + if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) { + CACHE_STACK_INFO(); + TRACE_ERROR(interp); + goto gotError; + } + CACHE_STACK_INFO(); + } else { + Tcl_ListObjIndex(NULL, value2Ptr, i, &o); + } + if (o != NULL) { + s2 = TclGetStringFromObj(o, &s2len); + } else { + s2 = ""; + s2len = 0; + } + if (s1len == s2len) { + match = (memcmp(s1, s2, s1len) == 0); + } + + /* Could be an ephemeral abstract obj */ + Tcl_BounceRefCount(o); + + i++; + } while (i < length && match == 0); + } + } if (*pc == INST_LIST_NOT_IN) { match = !match; @@ -5166,8 +5168,7 @@ TEBCresume( NEXT_INST_F(1, 1, 0); } - case INST_LREPLACE4: - { + case INST_LREPLACE4: { size_t numToDelete, numNewElems; int end_indicator; int haveSecondIndex, flags; @@ -5563,7 +5564,7 @@ TEBCresume( if ((*ustring1 == *ustring2) && /* Fix bug [69218ab7b]: restrict max compare length. */ ((end - ustring1) >= length2) && (length2 == 1 || - memcmp(ustring1, ustring2, + memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); @@ -6604,7 +6605,6 @@ TEBCresume( } CACHE_STACK_INFO(); - valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { if (valIndex >= listLen) { @@ -7383,7 +7383,7 @@ TEBCresume( goto gotError; } DECACHE_STACK_INFO(); - result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1, + result = TclDictWithFinish(interp, varPtr, arrayPtr, varNamePtr, NULL, -1, objc, objv, keysPtr); CACHE_STACK_INFO(); TclDecrRefCount(keysPtr); @@ -7426,39 +7426,38 @@ TEBCresume( * ----------------------------------------------------------------- */ - case INST_CLOCK_READ: - { /* Read the wall clock */ - Tcl_WideInt wval; - Tcl_Time now; - switch (TclGetUInt1AtPtr(pc+1)) { - case 0: /* clicks */ + case INST_CLOCK_READ: { /* Read the wall clock */ + Tcl_WideInt wval; + Tcl_Time now; + switch (TclGetUInt1AtPtr(pc+1)) { + case 0: /* clicks */ #ifdef TCL_WIDE_CLICKS - wval = TclpGetWideClicks(); + wval = TclpGetWideClicks(); #else - wval = (Tcl_WideInt)TclpGetClicks(); + wval = (Tcl_WideInt)TclpGetClicks(); #endif - break; - case 1: /* microseconds */ - Tcl_GetTime(&now); - wval = (Tcl_WideInt)now.sec * 1000000 + now.usec; - break; - case 2: /* milliseconds */ - Tcl_GetTime(&now); - wval = (Tcl_WideInt)now.sec * 1000 + now.usec / 1000; - break; - case 3: /* seconds */ - Tcl_GetTime(&now); - wval = (Tcl_WideInt)now.sec; - break; - default: - Tcl_Panic("clockRead instruction with unknown clock#"); - break; - } - TclNewIntObj(objResultPtr, wval); - TRACE_WITH_OBJ(("=> "), objResultPtr); - NEXT_INST_F(2, 0, 1); + break; + case 1: /* microseconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt)now.sec * 1000000 + now.usec; + break; + case 2: /* milliseconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt)now.sec * 1000 + now.usec / 1000; + break; + case 3: /* seconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt)now.sec; + break; + default: + Tcl_Panic("clockRead instruction with unknown clock#"); + break; } - break; + TclNewIntObj(objResultPtr, wval); + TRACE_WITH_OBJ(("=> "), objResultPtr); + NEXT_INST_F(2, 0, 1); + } + break; default: Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc); @@ -8657,17 +8656,17 @@ ExecuteExtendedBinaryMathOp( Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); err = mp_init(&bigResult); if (err == MP_OKAY) { - switch (opcode) { - case INST_ADD: + switch (opcode) { + case INST_ADD: err = mp_add(&big1, &big2, &bigResult); break; - case INST_SUB: + case INST_SUB: err = mp_sub(&big1, &big2, &bigResult); break; - case INST_MULT: + case INST_MULT: err = mp_mul(&big1, &big2, &bigResult); break; - case INST_DIV: + case INST_DIV: if (mp_iszero(&big2)) { mp_clear(&big1); mp_clear(&big2); @@ -8961,19 +8960,26 @@ TclCompareTwoNumbers( static void PrintByteCodeInfo( - ByteCode *codePtr) /* The bytecode whose summary is printed to + 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 %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n", + fprintf(stdout, + "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER + "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" + TCL_Z_MODIFIER "u)\n", codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); fprintf(stdout, " Source: "); TclPrintSource(stdout, codePtr->source, 60); - fprintf(stdout, "\n Cmds %" TCL_Z_MODIFIER "u, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n", + fprintf(stdout, + "\n Cmds %" TCL_Z_MODIFIER "u, src %" TCL_Z_MODIFIER + "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER + "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER + "u, code/src %.2f\n", codePtr->numCommands, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, codePtr->maxStackDepth, @@ -8984,8 +8990,11 @@ PrintByteCodeInfo( 0.0); #ifdef TCL_COMPILE_STATS - fprintf(stdout, " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER - "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n", + fprintf(stdout, + " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER + "u+inst %" TCL_Z_MODIFIER "u+litObj %" TCL_Z_MODIFIER + "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER + "u+cmdMap %" TCL_Z_MODIFIER "u\n", codePtr->structureSize, offsetof(ByteCode, localCachePtr), codePtr->numCodeBytes, @@ -8996,7 +9005,8 @@ PrintByteCodeInfo( #endif /* TCL_COMPILE_STATS */ if (procPtr != NULL) { fprintf(stdout, - " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %" TCL_Z_MODIFIER "u\n", + " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %" + TCL_Z_MODIFIER "u, compiled locals %" TCL_Z_MODIFIER "u\n", procPtr, procPtr->refCount, procPtr->numArgs, procPtr->numCompiledLocals); } @@ -9025,7 +9035,7 @@ PrintByteCodeInfo( #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( - ByteCode *codePtr, /* The bytecode whose summary is printed to + 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. */ @@ -9065,7 +9075,7 @@ ValidatePcAndStackTop( TclNewLiteralStringObj(message, "\n executing "); Tcl_IncrRefCount(message); Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL); - fprintf(stderr,"%s\n", TclGetString(message)); + fprintf(stderr, "%s\n", TclGetString(message)); Tcl_DecrRefCount(message); } else { fprintf(stderr, "\n"); @@ -9097,7 +9107,7 @@ static void IllegalExprOperandType( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ - const unsigned char *pc, /* Points to the instruction being executed + const unsigned char *pc, /* Points to the instruction being executed * when the illegal type was found. */ Tcl_Obj *opndPtr) /* Points to the operand holding the value * with the illegal type. */ @@ -9161,21 +9171,21 @@ TclGetSourceFromFrame( Tcl_Obj *const objv[]) { if (cfPtr == NULL) { - return Tcl_NewListObj(objc, objv); + return Tcl_NewListObj(objc, objv); } if (cfPtr->cmdObj == NULL) { - if (cfPtr->cmd == NULL) { + if (cfPtr->cmd == NULL) { ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; - cfPtr->cmd = GetSrcInfoForPc((unsigned char *) + cfPtr->cmd = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); - } + } if (cfPtr->cmd) { cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len); } else { cfPtr->cmdObj = Tcl_NewListObj(objc, objv); } - Tcl_IncrRefCount(cfPtr->cmdObj); + Tcl_IncrRefCount(cfPtr->cmdObj); } return cfPtr->cmdObj; } @@ -9547,7 +9557,7 @@ TclExprFloatError( int TclLog2( - int value) /* The integer for which to compute the log + int value) /* The integer for which to compute the log * base 2. */ { int n = value; @@ -9816,23 +9826,23 @@ EvalStatsCmd( currentHeaderBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Instructions %12.6g %8.1f%% %8.1f\n", statsPtr->currentInstBytes, - Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentInstBytes, statsPtr->currentByteCodeBytes), statsPtr->currentInstBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Literal ptr array %12.6g %8.1f%% %8.1f\n", statsPtr->currentLitBytes, - Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentLitBytes, statsPtr->currentByteCodeBytes), statsPtr->currentLitBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Exception table %12.6g %8.1f%% %8.1f\n", statsPtr->currentExceptBytes, - Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentExceptBytes, statsPtr->currentByteCodeBytes), statsPtr->currentExceptBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Auxiliary data %12.6g %8.1f%% %8.1f\n", statsPtr->currentAuxBytes, - Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentAuxBytes, statsPtr->currentByteCodeBytes), statsPtr->currentAuxBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Command map %12.6g %8.1f%% %8.1f\n", statsPtr->currentCmdMapBytes, - Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentCmdMapBytes, statsPtr->currentByteCodeBytes), statsPtr->currentCmdMapBytes / numCurrentByteCodes); /* diff --git a/generic/tclHash.c b/generic/tclHash.c index 5be07cb..89807e2 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -214,7 +214,6 @@ FindHashEntry( { return CreateHashEntry(tablePtr, key, NULL); } - /* *---------------------------------------------------------------------- @@ -301,8 +300,7 @@ CreateHashEntry( } /* if needle pointer equals content pointer or values equal */ if ((key == hPtr->key.string) - || compareKeysProc((void *) key, hPtr) - ) { + || compareKeysProc((void *) key, hPtr)) { if (newPtr) { *newPtr = 0; } diff --git a/generic/tclIO.c b/generic/tclIO.c index 78cda5c..eec6062 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8711,9 +8711,8 @@ UpdateInterest( && (mask & TCL_WRITABLE) && GotFlag(statePtr, CHANNEL_NONBLOCKING) && bufPtr - && !IsBufferEmpty(bufPtr) - && !IsBufferFull(bufPtr) - ) { + && !IsBufferEmpty(bufPtr) + && !IsBufferFull(bufPtr)) { TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, @@ -8798,8 +8797,7 @@ ChannelTimerProc( static void DeleteTimerHandler( - ChannelState *statePtr -) + ChannelState *statePtr) { if (statePtr->timer != NULL) { Tcl_DeleteTimerHandler(statePtr->timer); @@ -8808,8 +8806,8 @@ DeleteTimerHandler( } static void CleanupTimerHandler( - ChannelState *statePtr -){ + ChannelState *statePtr) +{ TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); statePtr->timer = NULL; statePtr->timerChanPtr = NULL; @@ -10297,20 +10295,13 @@ Lossless( return inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF && outStatePtr->outputTranslation == TCL_TRANSLATE_LF - && ( - ( - inStatePtr->encoding == GetBinaryEncoding() - && - outStatePtr->encoding == GetBinaryEncoding() - ) - || - ( - toRead == -1 + && ((inStatePtr->encoding == GetBinaryEncoding() + && outStatePtr->encoding == GetBinaryEncoding()) + || (toRead == -1 && inStatePtr->encoding == outStatePtr->encoding && ENCODING_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 && ENCODING_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 - ) - ); + )); } /* diff --git a/generic/tclIO.h b/generic/tclIO.h index 08fff44..8823e06 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -191,8 +191,8 @@ typedef struct ChannelState { Tcl_Size bufSize; /* What size buffers to allocate? */ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ Channel *timerChanPtr; /* Needed in order to decrement the refCount of - the right channel when the timer is - deleted. */ + * the right channel when the timer is + * deleted. */ struct CopyState *csPtrR; /* State of background copy for which channel * is input, or NULL. */ struct CopyState *csPtrW; /* State of background copy for which channel diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index cb90059..fc4ddb6 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -606,7 +606,6 @@ Tcl_TellObjCmd( * them into the regular interpreter result. */ - code = TclChanCaughtErrorBypass(interp, chan); TclChannelRelease(chan); if (code) { diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index fe54f65..0118ce0 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -62,27 +62,27 @@ static void TimerRunWrite(void *clientData); */ static const Tcl_ChannelType tclRChannelType = { - "tclrchannel", /* Type name. */ + "tclrchannel", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close channel, clean instance data */ - ReflectInput, /* Handle read request */ - ReflectOutput, /* Handle write request */ + NULL, /* Old close API */ + ReflectInput, /* Handle read request */ + ReflectOutput, /* Handle write request */ NULL, - ReflectSetOption, /* Set options. NULL'able */ - ReflectGetOption, /* Get options. NULL'able */ - ReflectWatch, /* Initialize notifier */ - NULL, /* Get OS handle from the channel. NULL'able */ - ReflectClose, /* No close2 support. NULL'able */ - ReflectBlock, /* Set blocking/nonblocking. NULL'able */ - NULL, /* Flush channel. Not used by core. NULL'able */ - NULL, /* Handle events. NULL'able */ - ReflectSeekWide, /* Move access point (64 bit). NULL'able */ + ReflectSetOption, /* Set options. */ + ReflectGetOption, /* Get options. */ + ReflectWatch, /* Initialize notifier */ + NULL, /* Get OS handle from the channel. */ + ReflectClose, /* Close channel. Clean instance data */ + ReflectBlock, /* Set blocking/nonblocking. */ + NULL, /* Flush channel. */ + NULL, /* Handle events. */ + ReflectSeekWide, /* Move access point (64 bit). */ #if TCL_THREADS - ReflectThread, /* thread action, tracking owner */ + ReflectThread, /* thread action, tracking owner */ #else - NULL, /* thread action */ + NULL, /* thread action */ #endif - ReflectTruncate /* Truncate. NULL'able */ + ReflectTruncate /* Truncate. */ }; /* @@ -96,11 +96,10 @@ typedef struct { * Tcl level part of the channel. NULL here * signals the channel is dead because the * interpreter/thread containing its Tcl - * command is gone. - */ + * command is gone. */ #if TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ - Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ + Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif Tcl_Obj *cmd; /* Callback command prefix */ Tcl_Obj *methods; /* Methods to append to command prefix */ @@ -113,16 +112,12 @@ typedef struct { int dead; /* Boolean signal that some operations * should no longer be attempted. */ - Tcl_TimerToken readTimer; /* - A token for the timer that is scheduled in - order to call Tcl_NotifyChannel when the - channel is readable - */ - Tcl_TimerToken writeTimer; /* - A token for the timer that is scheduled in - order to call Tcl_NotifyChannel when the - channel is writable - */ + Tcl_TimerToken readTimer; /* A token for the timer that is scheduled in + * order to call Tcl_NotifyChannel when the + * channel is readable */ + Tcl_TimerToken writeTimer; /* A token for the timer that is scheduled in + * order to call Tcl_NotifyChannel when the + * channel is writable */ /* * Note regarding the usage of timers. @@ -266,7 +261,7 @@ typedef struct { struct ForwardParamInput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* O: Where to store the read bytes */ - Tcl_Size toRead; /* I: #bytes to read, + Tcl_Size toRead; /* I: #bytes to read, * O: #bytes actually read */ }; struct ForwardParamOutput { @@ -513,7 +508,7 @@ TclChanCreateObjCmd( Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Channel chan; /* Token for the new channel */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - Tcl_Size listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index c1e5c31..2ad6ecf0 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -58,18 +58,17 @@ static int ReflectNotify(void *clientData, int mask); static const Tcl_ChannelType tclRTransformType = { "tclrtransform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel. */ - NULL, /* Close channel, clean instance data. */ + NULL, ReflectInput, /* Handle read request. */ ReflectOutput, /* Handle write request. */ - NULL, /* Move location of access point. */ + NULL, /* Move location of access point. */ ReflectSetOption, /* Set options. */ ReflectGetOption, /* Get options. */ ReflectWatch, /* Initialize notifier. */ ReflectHandle, /* Get OS handle from the channel. */ - ReflectClose, /* No close2 support. NULL'able. */ + ReflectClose, /* Close channel, clean instance data. */ ReflectBlock, /* Set blocking/nonblocking. */ - NULL, /* Flush channel. Not used by core. - * NULL'able. */ + NULL, /* Flush channel. Not used by core. */ ReflectNotify, /* Handle events. */ ReflectSeekWide, /* Move access point (64 bit). */ NULL, /* thread action */ @@ -511,7 +510,7 @@ TclChanPushObjCmd( Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Obj *rtId; /* Handle of the new transform (channel) */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - Tcl_Size listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ @@ -1105,7 +1104,6 @@ ReflectInput( goto stop; } - /* * The buffer is exhausted, but the caller wants even more. We now * have to go to the underlying channel, get more bytes and then @@ -1141,7 +1139,6 @@ ReflectInput( goto stop; } - readBytes = Tcl_ReadRaw(rtPtr->parent, (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead); if (readBytes < 0) { @@ -1492,7 +1489,7 @@ ReflectBlock( static int ReflectSetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ const char *newValue) /* The new value */ @@ -1534,7 +1531,7 @@ ReflectSetOption( static int ReflectGetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ Tcl_DString *dsPtr) /* String to place the result into */ @@ -1645,7 +1642,6 @@ ReflectNotify( /* * Helpers. ========================================================= */ - /* *---------------------------------------------------------------------- @@ -2075,7 +2071,8 @@ static ReflectedTransformMap * GetReflectedTransformMap( Tcl_Interp *interp) { - ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL); + ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *) + Tcl_GetAssocData(interp, RTMKEY, NULL); if (rtmPtr == NULL) { rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap)); @@ -2108,7 +2105,7 @@ GetReflectedTransformMap( static void DeleteReflectedTransformMap( - void *clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedTransformMap *rtmPtr; /* The map */ @@ -2243,7 +2240,8 @@ GetThreadReflectedTransformMap(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rtmPtr) { - tsdPtr->rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap)); + tsdPtr->rtmPtr = (ReflectedTransformMap *) + Tcl_Alloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL); } @@ -2993,7 +2991,7 @@ static inline size_t ResultCopy( ResultBuffer *rPtr, /* The buffer to read from */ unsigned char *buf, /* The buffer to copy into */ - size_t toRead) /* Number of requested bytes */ + size_t toRead) /* Number of requested bytes */ { int copied; diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 47fde36..81526fa 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -18,7 +18,7 @@ typedef struct { int initialized; - Tcl_DString errorMsg; /* UTF-8 encoded error-message */ + Tcl_DString errorMsg; /* UTF-8 encoded error-message */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -75,7 +75,8 @@ TclSockGetPort( * Don't bother translating 'proto' to native. */ - if (Tcl_UtfToExternalDStringEx(interp, NULL, string, -1, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, string, -1, 0, &ds, + NULL) != TCL_OK) { Tcl_DStringFree(&ds); return TCL_ERROR; } @@ -188,7 +189,8 @@ TclCreateSocketAddress( int result; if (host != NULL) { - if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, + NULL) != TCL_OK) { Tcl_DStringFree(&ds); return 0; } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 6067282..c3131cd 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -35,7 +35,7 @@ */ typedef struct FilesystemRecord { - void *clientData; /* Client-specific data for the filesystem + void *clientData; /* Client-specific data for the filesystem * (can be NULL) */ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */ struct FilesystemRecord *nextPtr; @@ -52,13 +52,11 @@ typedef struct FilesystemRecord { typedef struct { int initialized; size_t cwdPathEpoch; /* Compared with the global cwdPathEpoch to - * determine whether cwdPathPtr is stale. - */ + * determine whether cwdPathPtr is stale. */ size_t filesystemEpoch; Tcl_Obj *cwdPathPtr; /* A private copy of cwdPathPtr. Updated when * the value is accessed and cwdPathEpoch has - * changed. - */ + * changed. */ void *cwdClientData; FilesystemRecord *filesystemList; size_t claims; @@ -106,7 +104,6 @@ static Tcl_FSFileAttrsSetProc NativeFileAttrsSet; MODULE_SCOPE const char *const tclpFileAttrStrings[]; MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; - /* * These these functions are not static either because routines in the native * (win/unix) directories call them or they are actually implemented in those @@ -242,7 +239,8 @@ typedef struct { /* Obsolete */ int Tcl_Stat( - const char *path, /* Pathname of file to stat (in current CP). */ + const char *path, /* Pathname of file to stat (in current system + * encoding). */ struct stat *oldStyleBuf) /* Filled with results of stat call. */ { int ret; @@ -329,8 +327,8 @@ Tcl_Stat( /* Obsolete */ int Tcl_Access( - const char *path, /* Pathname of file to access (in current CP). - */ + const char *path, /* Pathname of file to access (in current + * system encoding). */ int mode) /* Permission setting. */ { int ret; @@ -845,7 +843,7 @@ TclResetFilesystem(void) int Tcl_FSRegister( - void *clientData, /* Client-specific data for this filesystem. */ + void *clientData, /* Client-specific data for this filesystem. */ const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */ { FilesystemRecord *newFilesystemPtr; @@ -1105,8 +1103,7 @@ FsAddMountsToGlobResult( Tcl_Obj *pathPtr, /* The directory that was searched. */ const char *pattern, /* Pattern to match mounts against. */ Tcl_GlobTypeData *types) /* Acceptable types. May be NULL. The - * directory flag is particularly significant. - */ + * directory flag is particularly significant. */ { Tcl_Size mLength, gLength, i; int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR)); @@ -1171,7 +1168,6 @@ FsAddMountsToGlobResult( } len++; /* account for '/' in the mElt [Bug 1602539] */ - mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len); Tcl_ListObjAppendElement(NULL, resultPtr, mElt); } @@ -1365,7 +1361,6 @@ TclFSNormalizeToUniquePath( Claim(); if (!isVfsPath) { - /* * Find and call the native filesystem handler first if there is one * because the root of Tcl's filesystem is always a native filesystem @@ -1693,7 +1688,7 @@ Tcl_FSEvalFileEx( * Tilde-substitution is performed on this * pathname. */ const char *encodingName) /* Either the name of an encoding or NULL to - use the utf-8 encoding. */ + * use the utf-8 encoding. */ { Tcl_Size length; int result = TCL_ERROR; @@ -2086,7 +2081,7 @@ Tcl_PosixError( int Tcl_FSStat( Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in - * current CP). */ + * current system encoding). */ Tcl_StatBuf *buf) /* A buffer to hold the results of the call to * stat. */ { @@ -2121,7 +2116,7 @@ Tcl_FSStat( int Tcl_FSLstat( Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in - current CP). */ + * current system encoding). */ Tcl_StatBuf *buf) /* Filled with results of that call to stat. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -2158,7 +2153,8 @@ Tcl_FSLstat( int Tcl_FSAccess( - Tcl_Obj *pathPtr, /* Pathname of file to access (in current CP). */ + Tcl_Obj *pathPtr, /* Pathname of file to access (in current + * system encoding). */ int mode) /* Permission setting. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -2195,12 +2191,11 @@ Tcl_FSOpenFileChannel( const char *modeString, /* A list of POSIX open modes or a string such * as "rw". */ int permissions) /* What modes to use if opening the file - involves creating it. */ + * involves creating it. */ { const Tcl_Filesystem *fsPtr; Tcl_Channel retVal = NULL; - if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { /* * Return the correct error message. @@ -3020,8 +3015,8 @@ Tcl_FSChdir( int Tcl_FSLoadFile( Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic shared object. - */ + Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic + * shared object. */ const char *sym1, const char *sym2, /* Names of two functions to find in the * dynamic shared object. */ @@ -3109,14 +3104,13 @@ skipUnlink( * * 1. The operating system is HPUX. * - * 2. If the environment variable TCL_TEMPLOAD_NO_UNLINK is present and - * set to true (an integer > 0) - * - * 3. TCL_TEMPLOAD_NO_UNLINK is not true (an integer > 0) and AUFS filesystem can be detected (using statfs, if available). + * 2. If the environment variable TCL_TEMPLOAD_NO_UNLINK is present and + * set to true (an integer > 0) * + * 3. TCL_TEMPLOAD_NO_UNLINK is not true (an integer > 0) and AUFS + * filesystem can be detected (using statfs, if available). */ - #ifdef hpux (void)shlibFile; return 1; @@ -3655,9 +3649,7 @@ Tcl_FSUnloadFile( Tcl_Obj * Tcl_FSLink( Tcl_Obj *pathPtr, /* Pathaname of file. */ - Tcl_Obj *toPtr, /* - * NULL or the pathname of a file to link to. - */ + Tcl_Obj *toPtr, /* NULL or the pathname of a file to link to. */ int linkAction) /* Action to perform. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -3906,7 +3898,8 @@ TclGetPathType( /* If not NULL, a place in which to store a * pointer to the filesystem for this pathname * if it is absolute. */ - Tcl_Size *driveNameLengthPtr, /* If not NULL, a place in which to store the + Tcl_Size *driveNameLengthPtr, + /* If not NULL, a place in which to store the * length of the volume name. */ Tcl_Obj **driveNameRef) /* If not NULL, for an absolute pathname, a * place to store a pointer to an object with a @@ -3960,9 +3953,9 @@ TclFSNonnativePathType( /* If not NULL, a place to store a pointer to * the filesystem for this pathname when it is * an absolute pathname. */ - Tcl_Size *driveNameLengthPtr,/* If not NULL, a place to store the length of - * the volume name if the pathname is absolute. - */ + Tcl_Size *driveNameLengthPtr, + /* If not NULL, a place to store the length of + * the volume name if the pathname is absolute. */ Tcl_Obj **driveNameRef) /* If not NULL, a place to store a pointer to * an object having its its refCount already * incremented, and contining the name of the @@ -4078,7 +4071,7 @@ TclFSNonnativePathType( int Tcl_FSRenameFile( Tcl_Obj *srcPathPtr, /* The pathname of a file or directory to be - renamed. */ + * renamed. */ Tcl_Obj *destPathPtr) /* The new pathname for the file. */ { int retVal = -1; diff --git a/generic/tclInt.h b/generic/tclInt.h index c714cb8..768143c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -257,7 +257,7 @@ typedef struct Namespace { * synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - void *clientData; /* An arbitrary value associated with this + void *clientData; /* An arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Procedure invoked when deleting the @@ -279,7 +279,7 @@ typedef struct Namespace { #else unsigned long nsId; #endif - Tcl_Interp *interp; /* The interpreter containing this + Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status * flags NS_DYING and NS_DEAD listed below. */ @@ -312,12 +312,12 @@ typedef struct Namespace { * registered using "namespace export". */ Tcl_Size maxExportPatterns; /* Number of export patterns for which space * is currently allocated. */ - Tcl_Size cmdRefEpoch; /* Incremented if a newly added command + Tcl_Size cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace * has already cached a Command* pointer; this * causes all its cached Command* pointers to * be invalidated. */ - Tcl_Size resolverEpoch; /* Incremented whenever (a) the name + Tcl_Size resolverEpoch; /* Incremented whenever (a) the name * resolution rules change for this namespace * or (b) a newly added command shadows a * command that is compiled to bytecodes. This @@ -424,8 +424,8 @@ struct NamespacePathEntry { * TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns. * TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces. * TCL_FIND_ONLY_NS - The name sought is a namespace name. - * TCL_FIND_IF_NOT_SIMPLE - Retrieve last namespace even if the rest of - * name is not simple name (contains ::). + * TCL_FIND_IF_NOT_SIMPLE - Retrieve last namespace even if the rest of + * name is not simple name (contains ::). */ #define TCL_CREATE_NS_IF_UNKNOWN 0x800 @@ -447,7 +447,7 @@ typedef struct EnsembleConfig { * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ - Tcl_Size epoch; /* The epoch at which this ensemble's table of + Tcl_Size epoch; /* The epoch at which this ensemble's table of * exported commands is valid. */ char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all * consistent points, this will have the same @@ -504,7 +504,7 @@ typedef struct EnsembleConfig { * core, presumably because the ensemble * itself has been updated. */ Tcl_Obj *parameterList; /* List of ensemble parameter names. */ - Tcl_Size numParameters; /* Cached number of parameters. This is either + Tcl_Size numParameters; /* Cached number of parameters. This is either * 0 (if the parameterList field is NULL) or * the length of the list in the parameterList * field. */ @@ -534,7 +534,7 @@ typedef struct EnsembleConfig { typedef struct VarTrace { Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by * flags are performed on variable. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_READS, TCL_TRACE_WRITES, @@ -553,7 +553,7 @@ typedef struct CommandTrace { Tcl_CommandTraceProc *traceProc; /* Procedure to call when operations given by * flags are performed on command. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ @@ -834,10 +834,10 @@ typedef struct VarInHash { #define TclVarFindHiddenArray(varPtr,arrayPtr) \ do { \ - if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ - (TclVarParentArray(varPtr) != NULL)) { \ - arrayPtr = TclVarParentArray(varPtr); \ - } \ + if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ + (TclVarParentArray(varPtr) != NULL)) { \ + arrayPtr = TclVarParentArray(varPtr); \ + } \ } while(0) #define TclIsVarScalar(varPtr) \ @@ -903,13 +903,13 @@ typedef struct VarInHash { #define TclIsVarTricky(varPtr,trickyFlags) \ ( ((varPtr)->flags & (VAR_ARRAY|VAR_LINK|trickyFlags)) \ - || (TclIsVarInHash(varPtr) \ - && (TclVarParentArray(varPtr) != NULL) \ - && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) + || (TclIsVarInHash(varPtr) \ + && (TclVarParentArray(varPtr) != NULL) \ + && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) #define TclIsVarDirectReadable(varPtr) \ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ)) \ - && (varPtr)->value.objPtr) + && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT)) @@ -919,7 +919,7 @@ typedef struct VarInHash { #define TclIsVarDirectModifyable(varPtr) \ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT)) \ - && (varPtr)->value.objPtr) + && (varPtr)->value.objPtr) #define TclIsVarDirectReadable2(varPtr, arrayPtr) \ (TclIsVarDirectReadable(varPtr) &&\ @@ -973,9 +973,9 @@ typedef struct CompiledLocal { /* Next compiler-recognized local variable for * this procedure, or NULL if this is the last * local. */ - Tcl_Size nameLength; /* The number of bytes in local variable's name. + Tcl_Size nameLength; /* The number of bytes in local variable's name. * Among others used to speed up var lookups. */ - Tcl_Size frameIndex; /* Index in the array of compiler-assigned + Tcl_Size frameIndex; /* Index in the array of compiler-assigned * variables in the procedure call frame. */ #if TCL_MAJOR_VERSION < 9 int flags; @@ -996,7 +996,7 @@ typedef struct CompiledLocal { * although only VAR_ARGUMENT, VAR_TEMPORARY, * and VAR_RESOLVED make sense. */ #endif - char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If + char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If * the name is NULL, this will just be '\0'. * The actual size of this field will be large * enough to hold the name. MUST BE THE LAST @@ -1058,7 +1058,7 @@ typedef struct Trace { #else Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */ #endif - void *clientData; /* Arbitrary value to pass to proc. */ + void *clientData; /* Arbitrary value to pass to proc. */ struct Trace *nextPtr; /* Next in list of traces for this interp. */ int flags; /* Flags governing the trace - see * Tcl_CreateObjTrace for details. */ @@ -1108,18 +1108,17 @@ typedef struct ActiveInterpTrace { ((objPtr)->typePtr)->proc : NULL) MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *); - /* * Abstract List * - * This structure provides the functions used in List operations to emulate a - * List for AbstractList types. + * This structure provides the functions used in List operations to emulate a + * List for AbstractList types. */ - static inline Tcl_Size -TclObjTypeLength(Tcl_Obj *objPtr) +TclObjTypeLength( + Tcl_Obj *objPtr) { Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc); return proc(objPtr); @@ -1188,15 +1187,17 @@ TclObjTypeReplace( return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs); } static inline int -TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj, - struct Tcl_Obj *listObj, int *boolResult) +TclObjTypeInOperator( + Tcl_Interp *interp, + Tcl_Obj *valueObj, + Tcl_Obj *listObj, + int *boolResult) { Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc); return proc(interp, valueObj, listObj, boolResult); } #endif /* TCL_MAJOR_VERSION > 8 */ - /* * The structure below defines an entry in the assocData hash table which is * associated with an interpreter. The entry contains a pointer to a function @@ -1206,7 +1207,7 @@ TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj, typedef struct AssocData { Tcl_InterpDeleteProc *proc; /* Proc to call when deleting. */ - void *clientData; /* Value to pass to proc. */ + void *clientData; /* Value to pass to proc. */ } AssocData; /* @@ -1250,11 +1251,10 @@ typedef struct CallFrame { * If FRAME_IS_PROC is set, the frame was * pushed to execute a Tcl procedure and may * have local vars. */ - Tcl_Size objc; /* This and objv below describe the arguments + Tcl_Size objc; /* This and objv below describe the arguments * for this procedure call. */ Tcl_Obj *const *objv; /* Array of argument objects. */ - struct CallFrame *callerPtr; - /* Value of interp->framePtr when this + struct CallFrame *callerPtr;/* Value of interp->framePtr when this * procedure was invoked (i.e. next higher in * stack of all active procedures). */ struct CallFrame *callerVarPtr; @@ -1264,7 +1264,7 @@ typedef struct CallFrame { * callerPtr unless an "uplevel" command or * something equivalent was active in the * caller). */ - Tcl_Size level; /* Level of this procedure, for "uplevel" + Tcl_Size level; /* Level of this procedure, for "uplevel" * purposes (i.e. corresponds to nesting of * callerVarPtr's, not callerPtr's). 1 for * outermost procedure, 0 for top-level. */ @@ -1284,7 +1284,7 @@ typedef struct CallFrame { * recognized by the compiler. The compiler * emits code that refers to these variables * using an index into this array. */ - void *clientData; /* Pointer to some context that is used by + void *clientData; /* Pointer to some context that is used by * object systems. The meaning of the contents * of this field is defined by the code that * sets it, and it should only ever be set by @@ -1294,8 +1294,7 @@ typedef struct CallFrame { * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; - Tcl_Obj *tailcallPtr; - /* NULL if no tailcall is scheduled */ + Tcl_Obj *tailcallPtr; /* NULL if no tailcall is scheduled */ } CallFrame; #define FRAME_IS_PROC 0x1 @@ -1384,7 +1383,7 @@ typedef struct CmdFrame { } data; Tcl_Obj *cmdObj; const char *cmd; /* The executed command, if possible... */ - Tcl_Size len; /* ... and its length. */ + Tcl_Size len; /* ... and its length. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have * ben pushed on the lineLABCPtr stack by @@ -1394,16 +1393,16 @@ typedef struct CmdFrame { typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ - Tcl_Size word; /* Index of the word in the command. */ + Tcl_Size word; /* Index of the word in the command. */ Tcl_Size refCount; /* Number of times the word is on the * stack. */ } CFWord; typedef struct CFWordBC { CmdFrame *framePtr; /* CmdFrame to access. */ - Tcl_Size pc; /* Instruction pointer of a command in + Tcl_Size pc; /* Instruction pointer of a command in * ExtCmdLoc.loc[.] */ - Tcl_Size word; /* Index of word in + Tcl_Size word; /* Index of word in * ExtCmdLoc.loc[cmd]->line[.] */ struct CFWordBC *prevPtr; /* Previous entry in stack for same Tcl_Obj. */ struct CFWordBC *nextPtr; /* Next entry for same command call. See @@ -1432,7 +1431,7 @@ typedef struct CFWordBC { #define CLL_END (-1) typedef struct ContLineLoc { - Tcl_Size num; /* Number of entries in loc, not counting the + Tcl_Size num; /* Number of entries in loc, not counting the * final -1 marker entry. */ Tcl_Size loc[TCLFLEXARRAY];/* Table of locations, as character offsets. * The table is allocated as part of the @@ -1475,14 +1474,14 @@ typedef struct ContLineLoc { typedef Tcl_Obj * (GetFrameInfoValueProc)(void *clientData); typedef struct { const char *name; /* Name of this field. */ - GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the + GetFrameInfoValueProc *proc;/* Function to generate a Tcl_Obj* from the * clientData, or just use the clientData * directly (after casting) if NULL. */ - void *clientData; /* Context for above function, or Tcl_Obj* if + void *clientData; /* Context for above function, or Tcl_Obj* if * proc field is NULL. */ } ExtraFrameInfoField; typedef struct { - Tcl_Size length; /* Length of array. */ + Tcl_Size length; /* Length of array. */ ExtraFrameInfoField fields[2]; /* Really as long as necessary, but this is * long enough for nearly anything. */ @@ -1605,22 +1604,22 @@ typedef struct CoroutineData { * the coroutine, which might be the * interpreter global environment or another * coroutine. */ - CorContext caller; - CorContext running; - Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ + CorContext caller; /* Caller's saved execution context. */ + CorContext running; /* This coroutine's saved execution context. */ + Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ void *stackLevel; - Tcl_Size auxNumLevels; /* While the coroutine is running the + Tcl_Size auxNumLevels; /* While the coroutine is running the * numLevels of the create/resume command is * stored here; for suspended coroutines it * holds the nesting numLevels at yield. */ - Tcl_Size nargs; /* Number of args required for resuming this - * coroutine; COROUTINE_ARGUMENTS_SINGLE_OPTIONAL means "0 or 1" - * (default), COROUTINE_ARGUMENTS_ARBITRARY means "any" */ + Tcl_Size nargs; /* Number of args required for resuming this + * coroutine; COROUTINE_ARGUMENTS_SINGLE_OPTIONAL + * means "0 or 1" (default), + * COROUTINE_ARGUMENTS_ARBITRARY means "any" */ Tcl_Obj *yieldPtr; /* The command to yield to. Stored here in * order to reset splice point in * TclNRCoroutineActivateCallback if the - * coroutine is busy. - */ + * coroutine is busy. */ } CoroutineData; typedef struct ExecEnv { @@ -1677,11 +1676,11 @@ typedef struct LiteralTable { LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables to avoid * mallocs and frees. */ - TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at + TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at * **buckets. */ - TCL_HASH_TYPE numEntries; /* Total number of entries present in + TCL_HASH_TYPE numEntries; /* Total number of entries present in * table. */ - TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be + TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ TCL_HASH_TYPE mask; /* Mask value used in hashing function. */ } LiteralTable; @@ -1694,10 +1693,11 @@ typedef struct LiteralTable { #ifdef TCL_COMPILE_STATS typedef struct ByteCodeStats { - size_t numExecutions; /* Number of ByteCodes executed. */ + size_t numExecutions; /* Number of ByteCodes executed. */ size_t numCompilations; /* Number of ByteCodes created. */ size_t numByteCodesFreed; /* Number of ByteCodes destroyed. */ - size_t instructionCount[256]; /* Number of times each instruction was + size_t instructionCount[256]; + /* Number of times each instruction was * executed. */ double totalSrcBytes; /* Total source bytes ever compiled. */ @@ -1705,7 +1705,7 @@ typedef struct ByteCodeStats { double currentSrcBytes; /* Src bytes for all current ByteCodes. */ double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */ - size_t srcCount[32]; /* Source size distribution: # of srcs of + size_t srcCount[32]; /* Source size distribution: # of srcs of * size [2**(n-1)..2**n), n in [0..32). */ size_t byteCodeCount[32]; /* ByteCode size distribution. */ size_t lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ @@ -1735,7 +1735,7 @@ typedef struct { Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */ CompileProc *compileProc; /* The compiler for the subcommand. */ Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */ - void *clientData; /* Any clientData to give the command. */ + void *clientData; /* Any clientData to give the command. */ int unsafe; /* Whether this command is to be hidden by * default in a safe interpreter. */ } EnsembleImplMap; @@ -1814,11 +1814,11 @@ typedef struct Command { Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */ void *objClientData; /* Arbitrary value passed to object proc. */ Tcl_CmdProc *proc; /* String-based command procedure. */ - void *clientData; /* Arbitrary value passed to string proc. */ + void *clientData; /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Procedure invoked when deleting command to, * e.g., free all client data. */ - void *deleteData; /* Arbitrary value passed to deleteProc. */ + void *deleteData; /* Arbitrary value passed to deleteProc. */ int flags; /* Miscellaneous bits of information about * command. See below for definitions. */ ImportRef *importRefPtr; /* List of each imported Command created in @@ -1857,14 +1857,13 @@ typedef struct Command { * (these last two flags are defined in tcl.h) */ -#define CMD_DYING 0x01 -#define CMD_TRACE_ACTIVE 0x02 -#define CMD_HAS_EXEC_TRACES 0x04 -#define CMD_COMPILES_EXPANDED 0x08 -#define CMD_REDEF_IN_PROGRESS 0x10 -#define CMD_VIA_RESOLVER 0x20 -#define CMD_DEAD 0x40 - +#define CMD_DYING 0x01 +#define CMD_TRACE_ACTIVE 0x02 +#define CMD_HAS_EXEC_TRACES 0x04 +#define CMD_COMPILES_EXPANDED 0x08 +#define CMD_REDEF_IN_PROGRESS 0x10 +#define CMD_VIA_RESOLVER 0x20 +#define CMD_DEAD 0x40 /* *---------------------------------------------------------------- @@ -1964,8 +1963,7 @@ typedef struct Interp { * enabled extensions check for a NULL pointer value * and for a TCL_STUBS_MAGIC value to verify they * are not [load]ing into one of those pre-stubs - * interps. - */ + * interps. */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ @@ -1975,7 +1973,7 @@ typedef struct Interp { /* Hash table used by tclBasic.c to keep track * of hidden commands on a per-interp * basis. */ - void *interpInfo; /* Information used by tclInterp.c to keep + void *interpInfo; /* Information used by tclInterp.c to keep * track of parent/child interps on a * per-interp basis. */ #if TCL_MAJOR_VERSION > 8 @@ -2054,7 +2052,7 @@ typedef struct Interp { * compiled by the interpreter. Indexed by the * string representations of literals. Used to * avoid creating duplicate objects. */ - Tcl_Size compileEpoch; /* Holds the current "compilation epoch" for + Tcl_Size compileEpoch; /* Holds the current "compilation epoch" for * this interpreter. This is incremented to * invalidate existing ByteCodes when, e.g., a * command with a compile procedure is @@ -2064,8 +2062,7 @@ typedef struct Interp { * NULL. Set by ObjInterpProc in tclProc.c and * used by tclCompile.c to process local * variables appropriately. */ - ResolverScheme *resolverPtr; - /* Linked list of name resolution schemes + ResolverScheme *resolverPtr;/* Linked list of name resolution schemes * added to this interpreter. Schemes are * added and removed by calling * Tcl_AddInterpResolvers and @@ -2100,8 +2097,8 @@ typedef struct Interp { ActiveInterpTrace *activeInterpTracePtr; /* First in list of active traces for interp, * or NULL if no active traces. */ - - Tcl_Size tracesForbiddingInline; /* Count of traces (in the list headed by + Tcl_Size tracesForbiddingInline; + /* Count of traces (in the list headed by * tracePtr) that forbid inline bytecode * compilation. */ @@ -2131,7 +2128,7 @@ typedef struct Interp { * as flag values the same as the 'active' * field. */ - Tcl_Size cmdCount; /* Limit for how many commands to execute in + Tcl_Size cmdCount; /* Limit for how many commands to execute in * the interpreter. */ LimitHandler *cmdHandlers; /* Handlers to execute when the limit is @@ -2167,9 +2164,9 @@ typedef struct Interp { * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not * processing an ensemble. */ - Tcl_Size numRemovedObjs; /* How many arguments have been stripped off + Tcl_Size numRemovedObjs;/* How many arguments have been stripped off * because of ensemble processing. */ - Tcl_Size numInsertedObjs; /* How many of the current arguments were + Tcl_Size numInsertedObjs;/* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; @@ -2208,7 +2205,7 @@ typedef struct Interp { * Proc structure for a procedure. The values * are "struct ExtCmdLoc*". (See * tclCompile.h) */ - Tcl_HashTable *lineLABCPtr; + Tcl_HashTable *lineLABCPtr; /* Tcl_Obj* (by exact pointer) -> CFWordBC* */ Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a * command on the execution stack the index of * the argument in the command, and the @@ -2229,8 +2226,7 @@ typedef struct Interp { * used by function ...() in the same file. * It does for the eval/direct path of script * execution what CompileEnv.clLoc does for - * the bytecode compiler. - */ + * the bytecode compiler. */ /* * TIP #268. The currently active selection mode, i.e. the package require * preferences. @@ -2302,7 +2298,7 @@ typedef struct Interp { Tcl_Obj *callLiteral; /* "CALL" literal for [info errorstack] */ Tcl_Obj *innerLiteral; /* "INNER" literal for [info errorstack] */ Tcl_Obj *innerContext; /* cached list for fast reallocation */ - int resetErrorStack; /* controls cleaning up of ::errorStack */ + int resetErrorStack; /* controls cleaning up of ::errorStack */ #ifdef TCL_COMPILE_STATS /* @@ -2329,10 +2325,10 @@ typedef struct Interp { #define TclCanceled(iPtr) \ (((iPtr)->flags & CANCELED) || ((iPtr)->flags & TCL_CANCEL_UNWIND)) -#define TclSetCancelFlags(iPtr, cancelFlags) \ - (iPtr)->flags |= CANCELED; \ - if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ - (iPtr)->flags |= TCL_CANCEL_UNWIND; \ +#define TclSetCancelFlags(iPtr, cancelFlags) \ + (iPtr)->flags |= CANCELED; \ + if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ + (iPtr)->flags |= TCL_CANCEL_UNWIND; \ } #define TclUnsetCancelFlags(iPtr) \ @@ -2494,7 +2490,8 @@ struct TclMaxAlignment { */ #define TclOOM(ptr, size) \ - ((size) && ((ptr)||(Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)),1))) + ((size) && ((ptr) || (Tcl_Panic( \ + "unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)), 1))) /* * The following enum values are used to specify the runtime platform setting @@ -2564,36 +2561,38 @@ typedef enum TclEolTranslation { * */ typedef struct ListStore { - Tcl_Size firstUsed; /* Index of first slot in use within slots[] */ - Tcl_Size numUsed; /* Number of slots in use (starting firstUsed) */ - Tcl_Size numAllocated; /* Total number of slots[] array slots. */ - size_t refCount; /* Number of references to this instance */ - int flags; /* LISTSTORE_* flags */ - Tcl_Obj *slots[TCLFLEXARRAY]; /* Variable size array. Grown as needed */ + Tcl_Size firstUsed; /* Index of first slot in use within slots[] */ + Tcl_Size numUsed; /* Number of slots in use (starting firstUsed) */ + Tcl_Size numAllocated; /* Total number of slots[] array slots. */ + size_t refCount; /* Number of references to this instance. */ + int flags; /* LISTSTORE_* flags */ + Tcl_Obj *slots[TCLFLEXARRAY]; + /* Variable size array. Grown as needed */ } ListStore; #define LISTSTORE_CANONICAL 0x1 /* All Tcl_Obj's referencing this - store have their string representation - derived from the list representation */ + * store have their string representation + * derived from the list representation */ /* Max number of elements that can be contained in a list */ -#define LIST_MAX \ - ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \ - / sizeof(Tcl_Obj *))) +#define LIST_MAX \ + ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \ + / sizeof(Tcl_Obj *))) /* Memory size needed for a ListStore to hold numSlots_ elements */ #define LIST_SIZE(numSlots_) \ - ((Tcl_Size)(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *)))) + ((Tcl_Size)(offsetof(ListStore, slots) \ + + ((numSlots_) * sizeof(Tcl_Obj *)))) /* * ListSpan -- * See comments above for ListStore */ typedef struct ListSpan { - Tcl_Size spanStart; /* Starting index of the span */ - Tcl_Size spanLength; /* Number of elements in the span */ - size_t refCount; /* Count of references to this span record */ + Tcl_Size spanStart; /* Starting index of the span. */ + Tcl_Size spanLength; /* Number of elements in the span. */ + size_t refCount; /* Count of references to this span record. */ } ListSpan; -#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */ +#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */ #define LIST_SPAN_THRESHOLD 101 #endif @@ -2602,9 +2601,11 @@ typedef struct ListSpan { * See comments above for ListStore */ typedef struct ListRep { - ListStore *storePtr;/* element array shared amongst different lists */ - ListSpan *spanPtr; /* If not NULL, the span holds the range of slots - within *storePtr that contain this list elements. */ + ListStore *storePtr; /* element array shared amongst different + * lists */ + ListSpan *spanPtr; /* If not NULL, the span holds the range of + * slots within *storePtr that contain this + * list elements. */ } ListRep; /* @@ -2620,14 +2621,16 @@ typedef struct ListRep { */ /* Returns the starting slot for this listRep in the contained ListStore */ -#define ListRepStart(listRepPtr_) \ - ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanStart \ - : (listRepPtr_)->storePtr->firstUsed) +#define ListRepStart(listRepPtr_) \ + ((listRepPtr_)->spanPtr \ + ? (listRepPtr_)->spanPtr->spanStart \ + : (listRepPtr_)->storePtr->firstUsed) /* Returns the number of elements in this listRep */ -#define ListRepLength(listRepPtr_) \ - ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanLength \ - : (listRepPtr_)->storePtr->numUsed) +#define ListRepLength(listRepPtr_) \ + ((listRepPtr_)->spanPtr \ + ? (listRepPtr_)->spanPtr->spanLength \ + : (listRepPtr_)->storePtr->numUsed) /* Returns a pointer to the first slot containing this ListRep elements */ #define ListRepElementsBase(listRepPtr_) \ @@ -2635,7 +2638,7 @@ typedef struct ListRep { /* Stores the number of elements and base address of the element array */ #define ListRepElements(listRepPtr_, objc_, objv_) \ - (((objv_) = ListRepElementsBase(listRepPtr_)), \ + (((objv_) = ListRepElementsBase(listRepPtr_)), \ ((objc_) = ListRepLength(listRepPtr_))) /* Returns 1/0 whether the ListRep's ListStore is shared. */ @@ -2650,34 +2653,36 @@ typedef struct ListRep { ((ListSpan *)((listObj_)->internalRep.twoPtrValue.ptr2)) /* Returns the ListRep internal representaton in a Tcl_Obj */ -#define ListObjGetRep(listObj_, listRepPtr_) \ - do { \ - (listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \ - (listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_); \ +#define ListObjGetRep(listObj_, listRepPtr_) \ + do { \ + (listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \ + (listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_); \ } while (0) /* Returns the length of the list */ -#define ListObjLength(listObj_, len_) \ - ((len_) = ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanLength \ - : ListObjStorePtr(listObj_)->numUsed) +#define ListObjLength(listObj_, len_) \ + ((len_) = ListObjSpanPtr(listObj_) \ + ? ListObjSpanPtr(listObj_)->spanLength \ + : ListObjStorePtr(listObj_)->numUsed) /* Returns the starting slot index of this list's elements in the ListStore */ -#define ListObjStart(listObj_) \ - (ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanStart \ - : ListObjStorePtr(listObj_)->firstUsed) +#define ListObjStart(listObj_) \ + (ListObjSpanPtr(listObj_) \ + ? ListObjSpanPtr(listObj_)->spanStart \ + : ListObjStorePtr(listObj_)->firstUsed) /* Stores the element count and base address of this list's elements */ #define ListObjGetElements(listObj_, objc_, objv_) \ (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \ (ListObjLength(listObj_, (objc_)))) - /* * Returns 1/0 whether the internal representation (not the Tcl_Obj itself) * is shared. Note by intent this only checks for sharing of ListStore, * not spans. */ -#define ListObjRepIsShared(listObj_) (ListObjStorePtr(listObj_)->refCount > 1) +#define ListObjRepIsShared(listObj_) \ + (ListObjStorePtr(listObj_)->refCount > 1) /* * Certain commands like concat are optimized if an existing string @@ -2694,10 +2699,10 @@ typedef struct ListRep { * and never from strings (see SetListFromAny) and thus their string * representation will always be canonical. */ -#define ListObjIsCanonical(listObj_) \ - (((listObj_)->bytes == NULL) \ - || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \ - || ListObjSpanPtr(listObj_) != NULL) +#define ListObjIsCanonical(listObj_) \ + (((listObj_)->bytes == NULL) \ + || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \ + || ListObjSpanPtr(listObj_) != NULL) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element @@ -2705,25 +2710,27 @@ typedef struct ListRep { * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be * converted to a list. */ -#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ - TCL_OK) \ - : Tcl_ListObjGetElements( \ - (interp_), (listObj_), (objcPtr_), (objvPtr_))) +#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ + TCL_OK) \ + : Tcl_ListObjGetElements( \ + (interp_), (listObj_), (objcPtr_), (objvPtr_))) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element * count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the * Tcl_Obj cannot be converted to a list. */ -#define TclListObjLength(interp_, listObj_, lenPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ - : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) +#define TclListObjLength(interp_, listObj_, lenPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ + : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) #define TclListObjIsCanonical(listObj_) \ - ((TclHasInternalRep((listObj_), &tclListType)) ? ListObjIsCanonical((listObj_)) : 0) + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ListObjIsCanonical((listObj_)) \ + : 0) /* * Modes for collecting (or not) in the implementations of TclNRForeachCmd, @@ -2743,44 +2750,45 @@ typedef struct ListRep { #if TCL_MAJOR_VERSION > 8 #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ - || TclHasInternalRep((objPtr), &tclBooleanType)) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ + || TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #else #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ + ((TclHasInternalRep((objPtr), &tclIntType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ - : (TclHasInternalRep((objPtr), &tclBooleanType)) \ + : (TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #endif #ifdef TCL_WIDE_INT_IS_LONG #define TclGetLongFromObj(interp, objPtr, longPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ - ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) + ((TclHasInternalRep((objPtr), &tclIntType)) \ + ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #else #define TclGetLongFromObj(interp, objPtr, longPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \ - ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) + ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #endif #define TclGetIntFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ - ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) + ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ - (((TclHasInternalRep((objPtr), &tclIntType)) && ((objPtr)->internalRep.wideValue >= 0) \ - && ((objPtr)->internalRep.wideValue <= endValue)) \ - ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) + (((TclHasInternalRep((objPtr), &tclIntType)) \ + && ((objPtr)->internalRep.wideValue >= 0) \ + && ((objPtr)->internalRep.wideValue <= endValue)) \ + ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* * Macro used to save a function call for common uses of @@ -2791,10 +2799,9 @@ typedef struct ListRep { */ #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ - ? (*(wideIntPtr) = \ - ((objPtr)->internalRep.wideValue), TCL_OK) : \ - Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) + ((TclHasInternalRep((objPtr), &tclIntType)) \ + ? (*(wideIntPtr) = ((objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) /* * Flag values for TclTraceDictPath(). @@ -2839,7 +2846,8 @@ typedef struct ListRep { #define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2) typedef void *(TclFSGetCwdProc2)(void *clientData); typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr, - Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); + Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, + int flags); /* * The following types are used for getting and storing platform-specific file @@ -2890,13 +2898,14 @@ typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp, *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, TCL_HASH_TYPE *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, + TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr); #ifdef _WIN32 # define TCLFSENCODING tclUtf8Encoding /* On Windows, all Unicode (except surrogates) are valid */ #else -# define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */ +# define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */ #endif /* @@ -2908,7 +2917,7 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, TCL_HASH_TYPE *len */ typedef struct ProcessGlobalValue { - Tcl_Size epoch; /* Epoch counter to detect changes in the + Tcl_Size epoch; /* Epoch counter to detect changes in the * global value. */ TCL_HASH_TYPE numBytes; /* Length of the global string. */ char *value; /* The global string value. */ @@ -2930,26 +2939,25 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------------- */ -#define TCL_PARSE_DECIMAL_ONLY 1 +#define TCL_PARSE_DECIMAL_ONLY 1 /* Leading zero doesn't denote octal or * hex. */ -#define TCL_PARSE_OCTAL_ONLY 2 +#define TCL_PARSE_OCTAL_ONLY 2 /* Parse octal even without prefix. */ #define TCL_PARSE_HEXADECIMAL_ONLY 4 /* Parse hexadecimal even without prefix. */ -#define TCL_PARSE_INTEGER_ONLY 8 +#define TCL_PARSE_INTEGER_ONLY 8 /* Disable floating point parsing. */ -#define TCL_PARSE_SCAN_PREFIXES 16 +#define TCL_PARSE_SCAN_PREFIXES 16 /* Use [scan] rules dealing with 0? * prefixes. */ -#define TCL_PARSE_NO_WHITESPACE 32 +#define TCL_PARSE_NO_WHITESPACE 32 /* Reject leading/trailing whitespace. */ #define TCL_PARSE_BINARY_ONLY 64 /* Parse binary even without prefix. */ #define TCL_PARSE_NO_UNDERSCORE 128 /* Reject underscore digit separator */ - /* *---------------------------------------------------------------------- * Internal convenience macros for manipulating encoding flags. See @@ -2958,11 +2966,12 @@ typedef struct ProcessGlobalValue { */ #define ENCODING_PROFILE_MASK 0xFF000000 -#define ENCODING_PROFILE_GET(flags_) ((flags_) & ENCODING_PROFILE_MASK) -#define ENCODING_PROFILE_SET(flags_, profile_) \ - do { \ - (flags_) &= ~ENCODING_PROFILE_MASK; \ - (flags_) |= ((profile_) & ENCODING_PROFILE_MASK);\ +#define ENCODING_PROFILE_GET(flags_) \ + ((flags_) & ENCODING_PROFILE_MASK) +#define ENCODING_PROFILE_SET(flags_, profile_) \ + do { \ + (flags_) &= ~ENCODING_PROFILE_MASK; \ + (flags_) |= ((profile_) & ENCODING_PROFILE_MASK); \ } while (0) /* @@ -2977,22 +2986,26 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------------- */ static inline Tcl_Size -TclUpsizeAlloc(TCL_UNUSED(Tcl_Size) /* oldSize. For future experiments with - * some growth algorithms that use this - * information. */, - Tcl_Size needed, - Tcl_Size limit) +TclUpsizeAlloc( + TCL_UNUSED(Tcl_Size), /* oldSize. For future experiments with + * some growth algorithms that use this + * information. */ + Tcl_Size needed, + Tcl_Size limit) { /* assert (oldCapacity < needed <= limit) */ if (needed < (limit - needed/2)) { return needed + needed / 2; - } - else { + } else { return limit; } } -static inline Tcl_Size TclUpsizeRetry(Tcl_Size needed, Tcl_Size lastAttempt) { - /* assert (needed < lastAttempt) */ +static inline Tcl_Size +TclUpsizeRetry( + Tcl_Size needed, + Tcl_Size lastAttempt) +{ + /* assert(needed < lastAttempt); */ if (needed < lastAttempt - 1) { /* (needed+lastAttempt)/2 but that formula may overflow Tcl_Size */ return needed + (lastAttempt - needed) / 2; @@ -3000,37 +3013,58 @@ static inline Tcl_Size TclUpsizeRetry(Tcl_Size needed, Tcl_Size lastAttempt) { return needed; } } -MODULE_SCOPE void *TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr); -MODULE_SCOPE void *TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount, - Tcl_Size elemSize, Tcl_Size leadSize, - Tcl_Size *capacityPtr); -MODULE_SCOPE void *TclAttemptReallocElemsEx(void *oldPtr, - Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr); +MODULE_SCOPE void * TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, + Tcl_Size leadSize, Tcl_Size *capacityPtr); +MODULE_SCOPE void * TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount, + Tcl_Size elemSize, Tcl_Size leadSize, + Tcl_Size *capacityPtr); +MODULE_SCOPE void * TclAttemptReallocElemsEx(void *oldPtr, + Tcl_Size elemCount, Tcl_Size elemSize, + Tcl_Size leadSize, Tcl_Size *capacityPtr); /* Alloc elemCount elements of size elemSize with leadSize header * returning actual capacity (in elements) in *capacityPtr. */ -static inline void *TclAttemptAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr) { +static inline void * +TclAttemptAllocElemsEx( + Tcl_Size elemCount, + Tcl_Size elemSize, + Tcl_Size leadSize, + Tcl_Size *capacityPtr) +{ return TclAttemptReallocElemsEx( - NULL, elemCount, elemSize, leadSize, capacityPtr); + NULL, elemCount, elemSize, leadSize, capacityPtr); } /* Alloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclAllocEx( + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclAllocElemsEx(numBytes, 1, 0, capacityPtr); } /* Alloc numByte bytes, returning actual capacity in *capacityPtr. */ static inline void * -TclAttemptAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) +TclAttemptAllocEx( + Tcl_Size numBytes, + Tcl_Size *capacityPtr) { return TclAttemptAllocElemsEx(numBytes, 1, 0, capacityPtr); } /* Realloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclReallocEx( + void *oldPtr, + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr); } /* Realloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclAttemptReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclAttemptReallocEx( + void *oldPtr, + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclAttemptReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr); } @@ -3051,13 +3085,12 @@ MODULE_SCOPE TclPlatformType tclPlatform; MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; MODULE_SCOPE Tcl_Encoding tclUtf8Encoding; -MODULE_SCOPE int -TclEncodingProfileNameToId(Tcl_Interp *interp, - const char *profileName, - int *profilePtr); +MODULE_SCOPE int TclEncodingProfileNameToId(Tcl_Interp *interp, + const char *profileName, + int *profilePtr); MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp, - int profileId); -MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); + int profileId); +MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); /* * TIP #233 (Virtualized Time) @@ -3155,12 +3188,13 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke; MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues; -MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); -MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); +MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, + Tcl_Obj *tailcallPtr); +MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); /* These two can be considered for the public api */ -MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); -MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); /* * This structure holds the data for the various iteration callbacks used to @@ -3177,7 +3211,7 @@ typedef struct ForIterData { Tcl_Obj *body; /* Loop body. */ Tcl_Obj *next; /* Loop step script, NULL for 'while'. */ const char *msg; /* Error message part. */ - Tcl_Size word; /* Index of the body script in the command */ + Tcl_Size word; /* Index of the body script in the command */ } ForIterData; /* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile @@ -3185,9 +3219,9 @@ typedef struct ForIterData { * typedef in tcl.h */ typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, - const char* symbol); + const char* symbol); struct Tcl_LoadHandle_ { - void *clientData; /* Client data is the load handle in the + void *clientData; /* Client data is the load handle in the * native filesystem if a module was loaded * there, or an opaque pointer to a structure * for further bookkeeping on load-from-VFS @@ -3201,16 +3235,12 @@ struct Tcl_LoadHandle_ { /* Flags for conversion of doubles to digit strings */ -#define TCL_DD_E_FORMAT 0x2 - /* Use a fixed-length string of digits, +#define TCL_DD_E_FORMAT 0x2 /* Use a fixed-length string of digits, * suitable for E format*/ -#define TCL_DD_F_FORMAT 0x3 - /* Use a fixed number of digits after the +#define TCL_DD_F_FORMAT 0x3 /* Use a fixed number of digits after the * decimal point, suitable for F format */ -#define TCL_DD_SHORTEST 0x4 - /* Use the shortest possible string */ -#define TCL_DD_NO_QUICK 0x8 - /* Debug flag: forbid quick FP conversion */ +#define TCL_DD_SHORTEST 0x4 /* Use the shortest possible string */ +#define TCL_DD_NO_QUICK 0x8 /* Debug flag: forbid quick FP conversion */ #define TCL_DD_CONVERSION_TYPE_MASK 0x3 /* Mask to isolate the conversion type */ @@ -3236,7 +3266,8 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, Tcl_Obj *objv[], int objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, - void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc); + void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, + Tcl_Size pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, @@ -3309,7 +3340,8 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp, - Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size *objcPtr); + Tcl_Obj *const *objv, Tcl_Size objc, + Tcl_Size *objcPtr); MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp); MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); @@ -3424,7 +3456,7 @@ MODULE_SCOPE Tcl_Size TclMaxListLength(const char *bytes, Tcl_Size numBytes, MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr); -MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); +MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); MODULE_SCOPE int TclNokia770Doubles(void); MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr); @@ -3449,15 +3481,16 @@ MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, MODULE_SCOPE void TclUndoRefCount(Tcl_Obj *objPtr); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); -MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, +MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); -MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr, - int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, - Tcl_Obj *stepObj, Tcl_Obj *lenObj); +MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, + Tcl_Obj **arithSeriesPtr, + int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, + Tcl_Obj *stepObj, Tcl_Obj *lenObj); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, Tcl_Size len); MODULE_SCOPE void TclpAlertNotifier(void *clientData); -MODULE_SCOPE void *TclpNotifierData(void); +MODULE_SCOPE void * TclpNotifierData(void); MODULE_SCOPE void TclpServiceModeHook(int mode); MODULE_SCOPE void TclpSetTimer(const Tcl_Time *timePtr); MODULE_SCOPE int TclpWaitForEvent(const Tcl_Time *timePtr); @@ -3487,7 +3520,7 @@ MODULE_SCOPE Tcl_Size TclpFindVariable(const char *name, Tcl_Size *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); -MODULE_SCOPE void *TclpInitNotifier(void); +MODULE_SCOPE void * TclpInitNotifier(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void); @@ -3569,13 +3602,14 @@ MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Size count, int *tokensLeftPtr, Tcl_Size line, Tcl_Size *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_Size TclTrim(const char *bytes, Tcl_Size numBytes, - const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight); + const char *trim, Tcl_Size numTrim, + Tcl_Size *trimRight); MODULE_SCOPE Tcl_Size TclTrimLeft(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE Tcl_Size TclTrimRight(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); -MODULE_SCOPE int TclObjInterpProc(void *clientData, +MODULE_SCOPE int TclObjInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclRegisterCommandTypeName( @@ -3601,16 +3635,16 @@ MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); #ifdef TCL_WIDE_CLICKS -MODULE_SCOPE long long TclpGetWideClicks(void); +MODULE_SCOPE long long TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(long long clicks); MODULE_SCOPE double TclpWideClickInMicrosec(void); #else # ifdef _WIN32 # define TCL_WIDE_CLICKS 1 -MODULE_SCOPE long long TclpGetWideClicks(void); +MODULE_SCOPE long long TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClickInMicrosec(void); -# define TclpWideClicksToNanoseconds(clicks) \ - ((double)(clicks) * TclpWideClickInMicrosec() * 1000) +# define TclpWideClicksToNanoseconds(clicks) \ + ((double)(clicks) * TclpWideClickInMicrosec() * 1000) # endif #endif MODULE_SCOPE long long TclpGetMicroseconds(void); @@ -3634,8 +3668,8 @@ MODULE_SCOPE void TclZipfsFinalize(void); */ MODULE_SCOPE int TclIsSpaceProc(int byte); -# define TclIsSpaceProcM(byte) \ - (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte)) +#define TclIsSpaceProcM(byte) \ + (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte)) /* *---------------------------------------------------------------- @@ -4004,14 +4038,13 @@ MODULE_SCOPE int TclFullFinalizationRequested(void); * TIP #542 */ -MODULE_SCOPE size_t TclUniCharLen(const Tcl_UniChar *uniStr); -MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); -MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); -MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, - const Tcl_UniChar *uniPattern, int nocase); - +MODULE_SCOPE size_t TclUniCharLen(const Tcl_UniChar *uniStr); +MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, + const Tcl_UniChar *uniPattern, int nocase); /* * Just for the purposes of command-type registration. @@ -4070,13 +4103,14 @@ MODULE_SCOPE Tcl_Size TclIndexDecode(int encoded, Tcl_Size endValue); /* * Error message utility functions */ -MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count); +MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, + Tcl_Size count); #endif /* TCL_MAJOR_VERSION > 8 */ /* Constants used in index value encoding routines. */ -#define TCL_INDEX_END ((Tcl_Size)-2) -#define TCL_INDEX_START ((Tcl_Size)0) +#define TCL_INDEX_END ((Tcl_Size)-2) +#define TCL_INDEX_START ((Tcl_Size)0) /* *---------------------------------------------------------------------- @@ -4155,20 +4189,20 @@ TclScaleTime( # define TclIncrObjsFreed() #endif /* TCL_COMPILE_STATS */ -# define TclAllocObjStorage(objPtr) \ +# define TclAllocObjStorage(objPtr) \ TclAllocObjStorageEx(NULL, (objPtr)) -# define TclFreeObjStorage(objPtr) \ +# define TclFreeObjStorage(objPtr) \ TclFreeObjStorageEx(NULL, (objPtr)) #ifndef TCL_MEM_DEBUG # define TclNewObj(objPtr) \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = &tclEmptyString; \ - (objPtr)->length = 0; \ - (objPtr)->typePtr = NULL; \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = &tclEmptyString; \ + (objPtr)->length = 0; \ + (objPtr)->typePtr = NULL; \ TCL_DTRACE_OBJ_CREATE(objPtr) /* @@ -4179,19 +4213,19 @@ TclScaleTime( */ # define TclDecrRefCount(objPtr) \ - if ((objPtr)->refCount-- > 1) ; else { \ - if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ - TCL_DTRACE_OBJ_FREE(objPtr); \ - if ((objPtr)->bytes \ - && ((objPtr)->bytes != &tclEmptyString)) { \ - Tcl_Free((objPtr)->bytes); \ - } \ - (objPtr)->length = TCL_INDEX_NONE; \ - TclFreeObjStorage(objPtr); \ - TclIncrObjsFreed(); \ - } else { \ - TclFreeObj(objPtr); \ - } \ + if ((objPtr)->refCount-- > 1) ; else { \ + if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ + TCL_DTRACE_OBJ_FREE(objPtr); \ + if ((objPtr)->bytes \ + && ((objPtr)->bytes != &tclEmptyString)) { \ + Tcl_Free((objPtr)->bytes); \ + } \ + (objPtr)->length = TCL_INDEX_NONE; \ + TclFreeObjStorage(objPtr); \ + TclIncrObjsFreed(); \ + } else { \ + TclFreeObj(objPtr); \ + } \ } #if TCL_THREADS && !defined(USE_THREAD_ALLOC) @@ -4298,11 +4332,11 @@ MODULE_SCOPE Tcl_Mutex tclObjMutex; } while (0) # define TclFreeObjStorageEx(interp, objPtr) \ - do { \ - Tcl_MutexLock(&tclObjMutex); \ + do { \ + Tcl_MutexLock(&tclObjMutex); \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \ - tclFreeObjList = (objPtr); \ - Tcl_MutexUnlock(&tclObjMutex); \ + tclFreeObjList = (objPtr); \ + Tcl_MutexUnlock(&tclObjMutex); \ } while (0) #endif @@ -4353,27 +4387,26 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclInitEmptyStringRep(objPtr) \ - ((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0)) - + ((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0)) #define TclInitStringRep(objPtr, bytePtr, len) \ - if ((len) == 0) { \ - TclInitEmptyStringRep(objPtr); \ - } else { \ - (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \ + if ((len) == 0) { \ + TclInitEmptyStringRep(objPtr); \ + } else { \ + (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \ memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \ - (objPtr)->bytes[len] = '\0'; \ - (objPtr)->length = (len); \ + (objPtr)->bytes[len] = '\0'; \ + (objPtr)->length = (len); \ } #define TclAttemptInitStringRep(objPtr, bytePtr, len) \ - ((((len) == 0) ? ( \ - TclInitEmptyStringRep(objPtr) \ - ) : ( \ - (objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \ - (objPtr)->length = ((objPtr)->bytes) ? \ + ((((len) == 0) ? ( \ + TclInitEmptyStringRep(objPtr) \ + ) : ( \ + (objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \ + (objPtr)->length = ((objPtr)->bytes) ? \ (memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)), \ - (objPtr)->bytes[len] = '\0', (len)) : (-1) \ + (objPtr)->bytes[len] = '\0', (len)) : (-1) \ )), (objPtr)->bytes) /* @@ -4392,8 +4425,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) #define TclGetStringFromObj(objPtr, lenPtr) \ - ((objPtr)->bytes \ - ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ + ((objPtr)->bytes \ + ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ : (Tcl_GetStringFromObj)((objPtr), (lenPtr))) /* @@ -4407,11 +4440,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclFreeInternalRep(objPtr) \ - if ((objPtr)->typePtr != NULL) { \ - if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ - (objPtr)->typePtr->freeIntRepProc(objPtr); \ - } \ - (objPtr)->typePtr = NULL; \ + if ((objPtr)->typePtr != NULL) { \ + if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ + (objPtr)->typePtr->freeIntRepProc(objPtr); \ + } \ + (objPtr)->typePtr = NULL; \ } /* @@ -4424,14 +4457,14 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclInvalidateStringRep(objPtr) \ - do { \ - Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ - if (_isobjPtr->bytes != NULL) { \ - if (_isobjPtr->bytes != &tclEmptyString) { \ - Tcl_Free((char *)_isobjPtr->bytes); \ - } \ - _isobjPtr->bytes = NULL; \ - } \ + do { \ + Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ + if (_isobjPtr->bytes != NULL) { \ + if (_isobjPtr->bytes != &tclEmptyString) { \ + Tcl_Free((char *)_isobjPtr->bytes); \ + } \ + _isobjPtr->bytes = NULL; \ + } \ } while (0) /* @@ -4474,8 +4507,8 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; #define TclUnpackBignum(objPtr, bignum) \ do { \ - Tcl_Obj *bignumObj = (objPtr); \ - int bignumPayload = \ + Tcl_Obj *bignumObj = (objPtr); \ + int bignumPayload = \ PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \ if (bignumPayload == -1) { \ (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \ @@ -4528,16 +4561,16 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; oldPtr = NULL; \ } \ newPtr = (Tcl_Token *)Tcl_AttemptRealloc((char *) oldPtr, \ - allocated * sizeof(Tcl_Token)); \ + allocated * sizeof(Tcl_Token)); \ if (newPtr == NULL) { \ allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH; \ newPtr = (Tcl_Token *)Tcl_Realloc((char *) oldPtr, \ - allocated * sizeof(Tcl_Token)); \ + allocated * sizeof(Tcl_Token)); \ } \ (available) = allocated; \ if (oldPtr == NULL) { \ memcpy(newPtr, staticPtr, \ - (used) * sizeof(Tcl_Token)); \ + (used) * sizeof(Tcl_Token)); \ } \ (tokenPtr) = newPtr; \ } \ @@ -4561,8 +4594,8 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; */ #define TclUtfToUniChar(str, chPtr) \ - (((UCHAR(*(str))) < 0x80) ? \ - ((*(chPtr) = UCHAR(*(str))), 1) \ + (((UCHAR(*(str))) < 0x80) ? \ + ((*(chPtr) = UCHAR(*(str))), 1) \ : Tcl_UtfToUniChar(str, chPtr)) /* @@ -4579,15 +4612,15 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; */ #define TclNumUtfCharsM(numChars, bytes, numBytes) \ - do { \ - Tcl_Size _count, _i = (numBytes); \ - unsigned char *_str = (unsigned char *) (bytes); \ - while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ - _count = (numBytes) - _i; \ - if (_i) { \ - _count += Tcl_NumUtfChars((bytes) + _count, _i); \ - } \ - (numChars) = _count; \ + do { \ + Tcl_Size _count, _i = (numBytes); \ + unsigned char *_str = (unsigned char *) (bytes); \ + while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ + _count = (numBytes) - _i; \ + if (_i) { \ + _count += Tcl_NumUtfChars((bytes) + _count, _i); \ + } \ + (numChars) = _count; \ } while (0); /* @@ -4607,12 +4640,11 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ - (((objPtr)->bytes==NULL) && TclHasInternalRep((objPtr), &tclDictType)) + (((objPtr)->bytes == NULL) && TclHasInternalRep((objPtr), &tclDictType)) #define TclHasInternalRep(objPtr, type) \ - ((objPtr)->typePtr == (type)) + ((objPtr)->typePtr == (type)) #define TclFetchInternalRep(objPtr, type) \ - (TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL) - + (TclHasInternalRep((objPtr), (type)) ? &(objPtr)->internalRep : NULL) /* *---------------------------------------------------------------- @@ -4658,7 +4690,6 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init; MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; - /* *---------------------------------------------------------------- * Macro used by the Tcl core to check whether a pattern has any characters @@ -4684,18 +4715,18 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; */ #define TclSetIntObj(objPtr, i) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.wideValue = (Tcl_WideInt) i; \ - TclInvalidateStringRep(objPtr); \ - Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.wideValue = (Tcl_WideInt) i; \ + TclInvalidateStringRep(objPtr); \ + Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \ } while (0) #define TclSetDoubleObj(objPtr, d) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.doubleValue = (double) d; \ - TclInvalidateStringRep(objPtr); \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.doubleValue = (double) d; \ + TclInvalidateStringRep(objPtr); \ Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir); \ } while (0) @@ -4715,58 +4746,58 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; #ifndef TCL_MEM_DEBUG #define TclNewIntObj(objPtr, w) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ - (objPtr)->typePtr = &tclIntType; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ + (objPtr)->typePtr = &tclIntType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewUIntObj(objPtr, uw) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - Tcl_WideUInt uw_ = (uw); \ - if (uw_ > WIDE_MAX) { \ - mp_int bignumValue_; \ - if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + Tcl_WideUInt uw_ = (uw); \ + if (uw_ > WIDE_MAX) { \ + mp_int bignumValue_; \ + if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \ Tcl_Panic("%s: memory overflow", "TclNewUIntObj"); \ - } \ - TclSetBignumInternalRep((objPtr), &bignumValue_); \ - } else { \ + } \ + TclSetBignumInternalRep((objPtr), &bignumValue_); \ + } else { \ (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \ - (objPtr)->typePtr = &tclIntType; \ - } \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + (objPtr)->typePtr = &tclIntType; \ + } \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewIndexObj(objPtr, w) \ TclNewIntObj(objPtr, w) #define TclNewDoubleObj(objPtr, d) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.doubleValue = (double)(d); \ - (objPtr)->typePtr = &tclDoubleType; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.doubleValue = (double)(d); \ + (objPtr)->typePtr = &tclDoubleType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewStringObj(objPtr, s, len) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - TclInitStringRep((objPtr), (s), (len)); \ - (objPtr)->typePtr = NULL; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + TclInitStringRep((objPtr), (s), (len)); \ + (objPtr)->typePtr = NULL; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #else /* TCL_MEM_DEBUG */ @@ -4774,18 +4805,18 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; (objPtr) = Tcl_NewWideIntObj(w) #define TclNewUIntObj(objPtr, uw) \ - do { \ - Tcl_WideUInt uw_ = (uw); \ - if (uw_ > WIDE_MAX) { \ - mp_int bignumValue_; \ - if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) { \ - (objPtr) = Tcl_NewBignumObj(&bignumValue_); \ - } else { \ - (objPtr) = NULL; \ - } \ - } else { \ - (objPtr) = Tcl_NewWideIntObj(uw_); \ - } \ + do { \ + Tcl_WideUInt uw_ = (uw); \ + if (uw_ > WIDE_MAX) { \ + mp_int bignumValue_; \ + if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) { \ + (objPtr) = Tcl_NewBignumObj(&bignumValue_); \ + } else { \ + (objPtr) = NULL; \ + } \ + } else { \ + (objPtr) = Tcl_NewWideIntObj(uw_); \ + } \ } while (0) #define TclNewIndexObj(objPtr, w) \ @@ -4837,28 +4868,26 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; * the internal stubs, but the core can use the macro instead. */ -#define TclCleanupCommandMacro(cmdPtr) \ +#define TclCleanupCommandMacro(cmdPtr) \ do { \ if ((cmdPtr)->refCount-- <= 1) { \ Tcl_Free(cmdPtr); \ } \ } while (0) - /* * inside this routine crement refCount first incase cmdPtr is replacing itself */ -#define TclRoutineAssign(location, cmdPtr) \ - do { \ - (cmdPtr)->refCount++; \ - if ((location) != NULL \ - && (location--) <= 1) { \ - Tcl_Free(((location))); \ - } \ - (location) = (cmdPtr); \ +#define TclRoutineAssign(location, cmdPtr) \ + do { \ + (cmdPtr)->refCount++; \ + if ((location) != NULL \ + && (location--) <= 1) { \ + Tcl_Free(((location))); \ + } \ + (location) = (cmdPtr); \ } while (0) - #define TclRoutineHasName(cmdPtr) \ ((cmdPtr)->hPtr != NULL) @@ -4871,9 +4900,10 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; * to the non-inline version. */ -#define TclLimitExceeded(limit) ((limit).exceeded != 0) +#define TclLimitExceeded(limit) \ + ((limit).exceeded != 0) -#define TclLimitReady(limit) \ +#define TclLimitReady(limit) \ (((limit).active == 0) ? 0 : \ (++(limit).granularityTicker, \ ((((limit).active & TCL_LIMIT_COMMANDS) && \ @@ -4991,7 +5021,8 @@ typedef struct NRE_callback { struct NRE_callback *nextPtr; } NRE_callback; -#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr) +#define TOP_CB(iPtr) \ + (((Interp *)(iPtr))->execEnvPtr->callbackPtr) /* * Inline version of Tcl_NRAddCallback. @@ -5030,9 +5061,9 @@ typedef struct NRE_callback { #include "tclIntPlatDecls.h" #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) -#define Tcl_AttemptAlloc TclpAlloc -#define Tcl_AttemptRealloc TclpRealloc -#define Tcl_Free TclpFree +#define Tcl_AttemptAlloc TclpAlloc +#define Tcl_AttemptRealloc TclpRealloc +#define Tcl_Free TclpFree #endif /* diff --git a/generic/tclInterp.c b/generic/tclInterp.c index b2d883b..5fbefbf 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -186,7 +186,7 @@ struct LimitHandler { int flags; /* The state of this particular handler. */ Tcl_LimitHandlerProc *handlerProc; /* The handler callback. */ - void *clientData; /* Opaque argument to the handler callback. */ + void *clientData; /* Opaque argument to the handler callback. */ Tcl_LimitHandlerDeleteProc *deleteProc; /* How to delete the clientData. */ LimitHandler *prevPtr; /* Previous item in linked list of @@ -207,8 +207,6 @@ struct LimitHandler { #define LIMIT_HANDLER_ACTIVE 0x01 #define LIMIT_HANDLER_DELETED 0x02 - - /* * Prototypes for local static functions: */ @@ -277,7 +275,6 @@ static void TimeLimitCallback(void *clientData); static Tcl_NRPostProc NRPostInvokeHidden; static Tcl_ObjCmdProc NRInterpCmd; static Tcl_ObjCmdProc NRChildCmd; - /* *---------------------------------------------------------------------- diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 2d925e7..1bb3587 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1616,8 +1616,7 @@ Tcl_Obj * TclListObjGetElement( Tcl_Obj *objPtr, /* List object for which an element array is * to be returned. */ - Tcl_Size index -) + Tcl_Size index) { return ListObjStorePtr(objPtr)->slots[ListObjStart(objPtr) + index]; } @@ -2018,7 +2017,6 @@ Tcl_ListObjLength( return TCL_OK; } - if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { return TCL_ERROR; } @@ -3552,7 +3550,6 @@ UpdateStringOfList( Tcl_Free(flagPtr); } } - /* *------------------------------------------------------------------------ diff --git a/generic/tclLoad.c b/generic/tclLoad.c index d7c13d1..c5a181d 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -12,7 +12,6 @@ #include "tclInt.h" - /* * The following structure describes a library that has been loaded either * dynamically (with the "load" command) or statically (as indicated by a call @@ -96,7 +95,6 @@ static int IsStatic(LoadedLibrary *libraryPtr); static int UnloadLibrary(Tcl_Interp *interp, Tcl_Interp *target, LoadedLibrary *library, int keepLibrary, const char *fullFileName, int interpExiting); - static int IsStatic( @@ -144,7 +142,7 @@ Tcl_LoadObjCmd( int flags = 0; Tcl_Obj *const *savedobjv = objv; static const char *const options[] = { - "-global", "-lazy", "--", NULL + "-global", "-lazy", "--", NULL }; enum loadOptionsEnum { LOAD_GLOBAL, LOAD_LAZY, LOAD_LAST @@ -168,7 +166,8 @@ Tcl_LoadObjCmd( } } if ((objc < 2) || (objc > 4)) { - Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"); + Tcl_WrongNumArgs(interp, 1, savedobjv, + "?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { @@ -753,7 +752,6 @@ Tcl_UnloadObjCmd( } return code; } - /* *---------------------------------------------------------------------- @@ -773,13 +771,12 @@ Tcl_UnloadObjCmd( */ static int UnloadLibrary( - Tcl_Interp *interp, - Tcl_Interp *target, - LoadedLibrary *libraryPtr, - int keepLibrary, - const char *fullFileName, - int interpExiting -) + Tcl_Interp *interp, + Tcl_Interp *target, + LoadedLibrary *libraryPtr, + int keepLibrary, + const char *fullFileName, + int interpExiting) { int code; InterpLibrary *ipFirstPtr, *ipPtr; @@ -821,8 +818,6 @@ UnloadLibrary( unloadProc = libraryPtr->unloadProc; } - - /* * We are ready to unload the library. First, evaluate the unload * function. If this fails, we cannot proceed with unload. Also, we must @@ -856,13 +851,11 @@ UnloadLibrary( code = unloadProc(target, code); } - if (code != TCL_OK) { Tcl_TransferResult(target, code, interp); goto done; } - /* * Remove this library from the interpreter's library cache. */ @@ -885,7 +878,6 @@ UnloadLibrary( Tcl_Free(ipPtr); Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); - if (IsStatic(libraryPtr)) { goto done; } @@ -1107,9 +1099,8 @@ TclGetLoadedLibraries( * NULL, return info about all interps; * otherwise, just return info about this * interpreter. */ - const char *prefix) /* Prefix or NULL. If NULL, return info - * for all prefixes. - */ + const char *prefix) /* Prefix or NULL. If NULL, return info + * for all prefixes. */ { Tcl_Interp *target; LoadedLibrary *libraryPtr; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 2a30742..eebf6aa 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -1079,8 +1079,7 @@ TclNamespaceDeleted( void TclDeleteNamespaceChildren( - Namespace *nsPtr /* Namespace whose children to delete */ -) + Namespace *nsPtr) /* Namespace whose children to delete */ { Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; @@ -3962,7 +3961,6 @@ NamespaceOriginCmd( Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } - /* *---------------------------------------------------------------------- @@ -5156,7 +5154,6 @@ Tcl_LogCommandInfo( { TclLogCommandInfo(interp, script, command, length, NULL, NULL); } - /* * Local Variables: diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 7695483..46ee8be 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -155,7 +155,6 @@ static const Tcl_ObjType methodNameType = { NULL, TCL_OBJTYPE_V0 }; - /* * ---------------------------------------------------------------------- diff --git a/generic/tclObj.c b/generic/tclObj.c index 30634a0..36856d4 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -349,7 +349,6 @@ typedef struct ResolvedCmdName { #define FREEDREFCOUNTFILLER \ (Tcl_Size)(sizeof(objPtr->refCount) == 4 ? 0xe8e8e8e8 : 0xe8e8e8e8e8e8e8e8) #endif - /* *------------------------------------------------------------------------- @@ -2568,7 +2567,6 @@ Tcl_GetIntFromObj( return TCL_OK; #endif } - /* *---------------------------------------------------------------------- diff --git a/generic/tclPanic.c b/generic/tclPanic.c index dcceb25..ed12640 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -81,7 +81,6 @@ Tcl_Panic( * to pass to fprintf. */ char *arg4, *arg5, *arg6, *arg7, *arg8; - va_start(argList, format); arg1 = va_arg(argList, char *); arg2 = va_arg(argList, char *); diff --git a/generic/tclParse.c b/generic/tclParse.c index 13e5c1e..e88de0b 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -1396,7 +1396,7 @@ Tcl_ParseVarName( case '}': braceCount--; break; case '\\': /* if 2 or more left, consume 2, else consume - just the \ and let it run into the end */ + * just the \ and let it run into the end */ if (numBytes > 1) { src++; numBytes--; } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 80954bc..9a44863 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -1519,7 +1519,6 @@ Tcl_FSNewNativePath( Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; - if (fromFilesystem->internalToNormalizedProc != NULL) { pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); } @@ -2689,7 +2688,6 @@ TclResolveTildePathList( return resolvedPaths; } - /* * Local Variables: diff --git a/generic/tclProc.c b/generic/tclProc.c index 40c6f32..2f87048 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -69,7 +69,7 @@ const Tcl_ObjType tclProcBodyType = { TCL_OBJTYPE_V0 }; -#define ProcSetInternalRep(objPtr, procPtr) \ +#define ProcSetInternalRep(objPtr, procPtr) \ do { \ Tcl_ObjInternalRep ir; \ (procPtr)->refCount++; \ @@ -78,11 +78,11 @@ const Tcl_ObjType tclProcBodyType = { Tcl_StoreInternalRep((objPtr), &tclProcBodyType, &ir); \ } while (0) -#define ProcGetInternalRep(objPtr, procPtr) \ +#define ProcGetInternalRep(objPtr, procPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \ - (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -116,23 +116,22 @@ static const Tcl_ObjType lambdaType = { TCL_OBJTYPE_V0 }; -#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \ +#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (procPtr); \ ir.twoPtrValue.ptr2 = (nsObjPtr); \ Tcl_IncrRefCount((nsObjPtr)); \ - Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \ + Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \ } while (0) -#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \ +#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &lambdaType); \ - (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ - (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &lambdaType); \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ + (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) - /* *---------------------------------------------------------------------- @@ -156,7 +155,7 @@ int Tcl_ProcObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -1095,7 +1094,8 @@ ProcWrongNumArgs( if (defPtr->value.objPtr != NULL) { TclNewObj(argObj); - Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", (void *)NULL); + Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", + (void *)NULL); } else if (defPtr->flags & VAR_IS_ARGS) { numArgs--; final = "?arg ...?"; @@ -1339,7 +1339,7 @@ InitLocalCache( static int InitArgsAndLocals( - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ int skip) /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ @@ -1503,9 +1503,9 @@ InitArgsAndLocals( int TclPushProcCallFrame( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ Tcl_Size objc, /* Count of number of arguments to this * procedure. */ @@ -1597,9 +1597,9 @@ TclPushProcCallFrame( int TclObjInterpProc( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ @@ -1614,11 +1614,11 @@ TclObjInterpProc( int TclNRInterpProc( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ - Tcl_Size objc, /* Count of number of arguments to this + Tcl_Size objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1637,7 +1637,7 @@ NRInterpProc( * interpreted. */ Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ - int objc, /* Count of number of arguments to this + int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1666,7 +1666,6 @@ ObjInterpProc2( return Tcl_NRCallObjProc2(interp, TclNRInterpProc, clientData, objc, objv); } - /* *---------------------------------------------------------------------- @@ -1688,10 +1687,10 @@ ObjInterpProc2( int TclNRInterpProcCore( - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ - Tcl_Size skip, /* Number of initial arguments to be skipped, + Tcl_Size skip, /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ ProcErrorProc *errorProc) /* How to convert results from the script into * results of the overall procedure. */ @@ -2137,7 +2136,7 @@ TclProcDeleteProc( void TclProcCleanupProc( - Proc *procPtr) /* Procedure to be deleted. */ + Proc *procPtr) /* Procedure to be deleted. */ { CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; @@ -2402,7 +2401,7 @@ ProcBodyFree( static void DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; @@ -2417,7 +2416,7 @@ DupLambdaInternalRep( static void FreeLambdaInternalRep( - Tcl_Obj *objPtr) /* CmdName object with internal representation + Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { Proc *procPtr; @@ -2435,7 +2434,7 @@ FreeLambdaInternalRep( static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 968e191..a5607d9 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -350,7 +350,6 @@ WaitProcessStatus( } } - /* *---------------------------------------------------------------------- * @@ -891,8 +890,7 @@ TclProcessWait( * - errno in case of error. * - non-zero exit code for abormal exit. * - signal number if killed or suspended. - * - Tcl_WaitPid status in all other cases. - */ + * - Tcl_WaitPid status in all other cases. */ Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */ Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */ { diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index bc6468d..04f060b 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -111,22 +111,21 @@ const Tcl_ObjType tclRegexpType = { TCL_OBJTYPE_V0 }; -#define RegexpSetInternalRep(objPtr, rePtr) \ +#define RegexpSetInternalRep(objPtr, rePtr) \ do { \ Tcl_ObjInternalRep ir; \ (rePtr)->refCount++; \ ir.twoPtrValue.ptr1 = (rePtr); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &tclRegexpType, &ir); \ + Tcl_StoreInternalRep((objPtr), &tclRegexpType, &ir); \ } while (0) -#define RegexpGetInternalRep(objPtr, rePtr) \ +#define RegexpGetInternalRep(objPtr, rePtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &tclRegexpType); \ - (rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \ + (rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) - /* *---------------------------------------------------------------------- @@ -223,8 +222,8 @@ Tcl_RegExpExec( Tcl_DStringInit(&ds); ustr = Tcl_UtfToUniCharDString(text, TCL_INDEX_NONE, &ds); numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar); - result = RegExpExecUniChar(interp, re, ustr, numChars, TCL_INDEX_NONE /* nmatches */, - flags); + result = RegExpExecUniChar(interp, re, ustr, numChars, + TCL_INDEX_NONE /* nmatches */, flags); Tcl_DStringFree(&ds); return result; @@ -306,7 +305,7 @@ RegExpExecUniChar( * previous call to Tcl_GetRegExpFromObj */ const Tcl_UniChar *wString, /* String against which to match re. */ size_t numChars, /* Length of Tcl_UniChar string. */ - size_t nm, /* How many subexpression matches (counting + size_t nm, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means "don't know". */ int flags) /* Regular expression flags. */ @@ -367,9 +366,9 @@ TclRegExpRangeUniChar( * > 0 means give the range of a matching * subrange, -1 means the range of the * rm_extend field. */ - Tcl_Size *startPtr, /* Store address of first character in + Tcl_Size *startPtr, /* Store address of first character in * (sub-)range here. */ - Tcl_Size *endPtr) /* Store address of character just after last + Tcl_Size *endPtr) /* Store address of character just after last * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; @@ -445,7 +444,7 @@ Tcl_RegExpExecObj( Tcl_Obj *textObj, /* Text against which to match re. */ Tcl_Size offset, /* Character index that marks where matching * should begin. */ - Tcl_Size nmatches, /* How many subexpression matches (counting + Tcl_Size nmatches, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means all of them. */ int flags) /* Regular expression execution flags. */ @@ -859,7 +858,7 @@ static TclRegexp * CompileRegexp( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ const char *string, /* The regexp to compile (UTF-8). */ - size_t length, /* The length of the string in bytes. */ + size_t length, /* The length of the string in bytes. */ int flags) /* Compilation flags. */ { TclRegexp *regexpPtr; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 87aab60..1b78184 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -26,7 +26,6 @@ # define PRIx64 TCL_LL_MODIFIER "x" #endif - /* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be @@ -4230,7 +4229,6 @@ StrictBignumConversion( * Extract the next group of digits. */ - if ((err != MP_OKAY) || (mp_div(&b, &S, &dig, &b) != MP_OKAY) || (dig.used > 1)) { Tcl_Panic("wrong digit!"); } @@ -4848,7 +4846,6 @@ TclBignumToDouble( mp_err err; const mp_int *a = (const mp_int *)big; - /* * We need a 'mantBits'-bit significand. Determine what shift will * give us that. diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 73391fe..05c578e 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -459,7 +459,6 @@ TclGetCharLength( return numChars; } - /* *---------------------------------------------------------------------- * @@ -3520,7 +3519,6 @@ TclStringCat( *--------------------------------------------------------------------------- */ - static int UniCharNcasememcmp( const void *ucsPtr, /* Unicode string to compare to uct. */ diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index 4e38a64..a7bca14 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -18,7 +18,6 @@ #ifndef _TCLSTRINGREP #define _TCLSTRINGREP - /* * The following structure is the internal rep for a String object. It keeps * track of how much memory has been used and how much has been allocated for diff --git a/generic/tclStubLibTbl.c b/generic/tclStubLibTbl.c index ad34494..6ac879c 100644 --- a/generic/tclStubLibTbl.c +++ b/generic/tclStubLibTbl.c @@ -33,14 +33,14 @@ MODULE_SCOPE void *tclStubsHandle; */ MODULE_SCOPE const char * TclInitStubTable( - const char *version) /* points to the version field of a - structure variable. */ + const char *version) /* points to the version field of a + * structure variable. */ { if (version) { if (tclStubsHandle == NULL) { - /* This can only happen with -DBUILD_STATIC, so simulate - * that the loading of Tcl succeeded, although we didn't - * actually load it dynamically */ + /* This can only happen with -DBUILD_STATIC, so simulate + * that the loading of Tcl succeeded, although we didn't + * actually load it dynamically */ tclStubsHandle = (void *)1; } tclStubsPtr = ((const TclStubs **) version)[-1]; diff --git a/generic/tclThread.c b/generic/tclThread.c index 698c642..c107780 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -145,7 +145,6 @@ RememberSyncObject( void **newList; int i, j; - /* * Reuse any free slot in the list. */ diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c index c0786c9..492c95f 100644 --- a/generic/tclTomMathStubLib.c +++ b/generic/tclTomMathStubLib.c @@ -18,7 +18,6 @@ MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr; const TclTomMathStubs *tclTomMathStubsPtr = NULL; - /* *---------------------------------------------------------------------- * diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 33085f3..f4e9fe5 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1016,7 +1016,6 @@ Tcl_TraceCommand( cmdPtr->flags |= CMD_HAS_EXEC_TRACES; } - return TCL_OK; } diff --git a/generic/tclUtf.c b/generic/tclUtf.c index e107081..03ea8b6 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1717,7 +1717,6 @@ TclUtfCmp( } return UCHAR(*cs) - UCHAR(*ct); } - /* *---------------------------------------------------------------------- @@ -1757,7 +1756,6 @@ TclUtfCasecmp( } return UCHAR(*cs) - UCHAR(*ct); } - /* *---------------------------------------------------------------------- diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0c9a3b2..3043fed 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2598,10 +2598,11 @@ char * Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *bytes, /* String to append. If length is - * TCL_INDEX_NONE then this must be null-terminated. */ + * TCL_INDEX_NONE then this must be + * null-terminated. */ Tcl_Size length) /* Number of bytes from "bytes" to append. If - * TCL_INDEX_NONE, then append all of bytes, up to null - * at end. */ + * TCL_INDEX_NONE, then append all of bytes, up + * to null at end. */ { Tcl_Size newSize; @@ -2617,7 +2618,6 @@ Tcl_DStringAppend( } newSize = length + dsPtr->length + 1; - if (newSize > dsPtr->spaceAvl) { if (dsPtr->string == dsPtr->staticSpace) { char *newString; diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 12f0ea0..b0bb383 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -217,9 +217,9 @@ typedef struct ZipEntry { ZipFile *zipFilePtr; /* The ZIP file holding this virtual file */ size_t offset; /* Data offset into memory mapped ZIP file */ int numBytes; /* Uncompressed size of the virtual file. - -1 for zip64 */ + * -1 for zip64 */ int numCompressedBytes; /* Compressed size of the virtual file. - -1 for zip64 */ + * -1 for zip64 */ int compressMethod; /* Compress method */ int isDirectory; /* 0 if file, 1 if directory, -1 if root */ int depth; /* Number of slashes in path. */ @@ -810,11 +810,13 @@ IsCryptHeaderValid( *------------------------------------------------------------------------ */ static int -DecodeCryptHeader(Tcl_Interp *interp, - ZipEntry *z, - unsigned long keys[3],/* Updated on success. Must have been - initialized by caller. */ - unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN]) /* From zip file content */ +DecodeCryptHeader( + Tcl_Interp *interp, + ZipEntry *z, + unsigned long keys[3], /* Updated on success. Must have been + * initialized by caller. */ + unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN]) + /* From zip file content */ { int i; int ch; @@ -1065,11 +1067,12 @@ errorReturn: *------------------------------------------------------------------------ */ static char * -MapPathToZipfs(Tcl_Interp *interp, - const char *mountPath, /* Must be fully normalized */ - const char *path, /* Archive content path to map */ - Tcl_DString *dsPtr) /* Must be initialized and cleared - by caller */ +MapPathToZipfs( + Tcl_Interp *interp, + const char *mountPath, /* Must be fully normalized */ + const char *path, /* Archive content path to map */ + Tcl_DString *dsPtr) /* Must be initialized and cleared + * by caller */ { const char *joiner[2]; char *joinedPath; diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index 9123656..d8af241 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -846,7 +846,6 @@ StartNotifierThread(void) } UNLOCK_NOTIFIER_INIT; } - /* *---------------------------------------------------------------------- diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index 062139a..ba49842 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -185,8 +185,7 @@ PlatformEventsControl( Tcl_Panic("fstat: %s", strerror(errno)); } else if ((fdStat.st_mode & S_IFMT) == S_IFREG || (fdStat.st_mode & S_IFMT) == S_IFDIR - || (fdStat.st_mode & S_IFMT) == S_IFLNK - ) { + || (fdStat.st_mode & S_IFMT) == S_IFLNK) { switch (op) { case EV_ADD: if (isNew) { diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index 12df7e4..de185fb 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -14,7 +14,6 @@ #include #include - /* * Static procedures defined within this file. */ diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 1c8b53a..81f314f 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -36,7 +36,6 @@ #include #include - /* * Static procedures defined within this file. */ diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 67bff10..81e3af5 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -335,7 +335,6 @@ static int MacOSXGetLibraryPath(Tcl_Interp *interp, MODULE_SCOPE long tclMacOSXDarwinRelease; long tclMacOSXDarwinRelease = 0; #endif - /* *--------------------------------------------------------------------------- diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 8715b4d..4c08464 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -108,10 +108,10 @@ static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName, static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ - NULL, + NULL, NULL, /* Set option proc. */ FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ @@ -140,7 +140,6 @@ static const Tcl_ChannelType fileChannelType = { #define POSIX_EPOCH_AS_FILETIME \ ((long long) 116444736 * (long long) 1000000000) - /* *---------------------------------------------------------------------- diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index b7288b7..8b289b1 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -280,7 +280,6 @@ static Tcl_ThreadDataKey dataKey; */ SRWLOCK gConsoleLock; - /* Process-wide list of console handles. Access control through gConsoleLock */ static ConsoleHandleInfo *gConsoleHandleInfoList; @@ -905,7 +904,7 @@ ConsoleCheckProc( /* See note above loop why this can be accessed without locks */ chanInfoPtr->flags |= CONSOLE_EVENT_QUEUED; chanInfoPtr->numRefs += 1; /* So it does not go away while event - is in queue */ + * is in queue */ evPtr->header.proc = ConsoleEventProc; evPtr->chanInfoPtr = chanInfoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -973,7 +972,7 @@ ConsoleBlockModeProc( static int ConsoleCloseProc( - void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ + void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index e7164df..0af484d 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -53,7 +53,6 @@ enum { static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; - const char *const tclpFileAttrStrings[] = { "-archive", "-hidden", "-longname", "-readonly", "-shortname", "-system", NULL diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 6de1432..9995602 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -75,11 +75,10 @@ typedef struct TclPipeThreadInfo { * to do read/write operation. Additionally * used as signal to stop (state set to -1) */ volatile LONG state; /* Indicates current state of the thread */ - void *clientData; /* Referenced data of the main thread */ + void *clientData; /* Referenced data of the main thread */ HANDLE evWakeUp; /* Optional wake-up event worker set by shutdown */ } TclPipeThreadInfo; - /* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without * more overhead for finalize thread (should be executed anyway) * @@ -99,7 +98,6 @@ typedef struct TclPipeThreadInfo { #define PTI_STATE_END 4 /* thread should stop work (worker is busy) */ #define PTI_STATE_DOWN 8 /* worker is down */ - MODULE_SCOPE TclPipeThreadInfo * TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr, void *clientData, HANDLE wakeEvent); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 3f0269c..dbf3324 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1187,7 +1187,6 @@ TclpCreateProcess( } return result; } - /* *---------------------------------------------------------------------- diff --git a/win/tclWinPort.h b/win/tclWinPort.h index efd9ff2..8ab4548 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -246,7 +246,6 @@ typedef DWORD_PTR * PDWORD_PTR; # define EWOULDBLOCK 140 /* Operation would block */ #endif - /* Visual Studio doesn't have these, so just choose some high numbers */ #ifndef ESOCKTNOSUPPORT # define ESOCKTNOSUPPORT 240 /* Socket type not supported */ @@ -415,7 +414,6 @@ typedef DWORD_PTR * PDWORD_PTR; # endif #endif /* !S_ISLNK */ - /* * Define MAXPATHLEN in terms of MAXPATH if available */ @@ -524,7 +522,6 @@ typedef DWORD_PTR * PDWORD_PTR; /* This type is not defined in the Windows headers */ #define socklen_t int - /* * The following macros have trivial definitions, allowing generic code to * address platform-specific issues. diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index d8193b4..e27937e 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -613,7 +613,6 @@ SerialCloseProc( return EINVAL; } - if (serialPtr->validMask & TCL_READABLE) { PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR); CloseHandle(serialPtr->osRead.hEvent); @@ -1480,7 +1479,6 @@ TclWinOpenSerialChannel( infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, infoPtr, permissions); - SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite); PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR); diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index d99de8c..d5c582b 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -79,10 +79,10 @@ static CRITICAL_SECTION joinLock; #if TCL_THREADS typedef struct ThreadSpecificData { - HANDLE condEvent; /* Per-thread condition event */ + HANDLE condEvent; /* Per-thread condition event */ struct ThreadSpecificData *nextPtr; /* Queue pointers */ struct ThreadSpecificData *prevPtr; - int flags; /* See flags below */ + int flags; /* See flags below */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -120,7 +120,7 @@ typedef struct { static DWORD tlsKey; typedef struct { - Tcl_Mutex tlock; + Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; #endif /* USE_THREAD_ALLOC */ @@ -131,12 +131,12 @@ typedef struct { */ typedef struct { - LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */ - LPVOID lpParameter; /* Original startup data */ - unsigned int fpControl; /* Floating point control word from the + LPTHREAD_START_ROUTINE lpStartAddress; + /* Original startup routine */ + LPVOID lpParameter; /* Original startup data */ + unsigned int fpControl; /* Floating point control word from the * main thread */ } WinThread; - /* *---------------------------------------------------------------------- @@ -567,9 +567,9 @@ Tcl_MutexLock( */ if (*mutexPtr == NULL) { - csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION)); + csPtr = (CRITICAL_SECTION *) Tcl_Alloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); - *mutexPtr = (Tcl_Mutex)csPtr; + *mutexPtr = (Tcl_Mutex) csPtr; TclRememberMutex(mutexPtr); } TclpGlobalUnlock(); @@ -659,7 +659,7 @@ void Tcl_ConditionWait( Tcl_Condition *condPtr, /* Really (WinCondition **) */ Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */ - const Tcl_Time *timePtr) /* Timeout on waiting period */ + const Tcl_Time *timePtr) /* Timeout on waiting period */ { WinCondition *winCondPtr; /* Per-condition queue head */ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */ @@ -926,9 +926,6 @@ TclpFinalizeCondition( } } - - - /* * Additions by AOL for specialized thread memory allocator. */ @@ -1030,7 +1027,6 @@ TclpFreeAllocCache( } #endif /* USE_THREAD_ALLOC */ - void * TclpThreadCreateKey(void) { diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 77f7547..5636dc0 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -103,7 +103,6 @@ static struct { double microsecsScale; /* Denominator scale between clock / microsecs */ } wideClick = {0, 0, 0.0}; - /* * Declarations for functions defined later in this file. */ -- cgit v0.12 From 8ecf0a8744aebc905939365a5c3f5155c2d636f9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 May 2024 20:33:38 +0000 Subject: Fix gcc warning: return should have value --- generic/tclOOCall.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 23db75c..c421cad 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -1691,7 +1691,7 @@ AddPrivatesFromClassChainToCallContext( tailRecurse: if (classPtr == NULL) { - return; + return 0; } FOREACH(superPtr, classPtr->mixins) { if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls, -- cgit v0.12 From d2433e65fa461c3df0432993584aa77913874c2d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 May 2024 09:04:45 +0000 Subject: b2 -> b3, as preparation for next release --- README.md | 2 +- changes.md | 2 +- generic/tcl.h | 4 ++-- library/http/http.tcl | 2 +- library/http/pkgIndex.tcl | 2 +- library/init.tcl | 2 +- library/manifest.txt | 2 +- unix/Makefile.in | 4 ++-- unix/configure | 2 +- unix/configure.ac | 2 +- unix/tcl.spec | 2 +- win/Makefile.in | 4 ++-- win/configure | 2 +- win/configure.ac | 2 +- 14 files changed, 17 insertions(+), 17 deletions(-) diff --git a/README.md b/README.md index 2edde12..0458901 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # README: Tcl -This is the **Tcl 9.0b2** source distribution. +This is the **Tcl 9.0b3** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). diff --git a/changes.md b/changes.md index fbb6b47..3cce62f 100644 --- a/changes.md +++ b/changes.md @@ -4,7 +4,7 @@ changes to the Tcl source code at > [Tcl Source Code](https://core.tcl-lang.org/tcl/timeline) -Release Tcl 9.0b2 arises from the check-in with tag core-9-0-b2. +Release Tcl 9.0b3 arises from the check-in with tag core-9-0-b3. Highlighted differences between Tcl 9.0 and Tcl 8.6 are summarized below, with focus on changes important to programmers using the Tcl library and diff --git a/generic/tcl.h b/generic/tcl.h index 947e4a7..41e68a8 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -53,10 +53,10 @@ extern "C" { #if TCL_MAJOR_VERSION == 9 # define TCL_MINOR_VERSION 0 # define TCL_RELEASE_LEVEL TCL_BETA_RELEASE -# define TCL_RELEASE_SERIAL 2 +# define TCL_RELEASE_SERIAL 3 # define TCL_VERSION "9.0" -# define TCL_PATCH_LEVEL "9.0b2" +# define TCL_PATCH_LEVEL "9.0b3" #endif /* TCL_MAJOR_VERSION */ #if defined(RC_INVOKED) diff --git a/library/http/http.tcl b/library/http/http.tcl index 1cf24b5..d53ecef 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.10b2 +package provide http 2.10b3 namespace eval http { # Allow resourcing to not clobber existing data diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 2428d53..0a872a7 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6-]} {return} -package ifneeded http 2.10b2 [list tclPkgSetup $dir http 2.10b2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.10b3 [list tclPkgSetup $dir http 2.10b3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/library/init.tcl b/library/init.tcl index 7190e95..72d0e75 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -15,7 +15,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -package require -exact tcl 9.0b2 +package require -exact tcl 9.0b3 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/library/manifest.txt b/library/manifest.txt index ab8bb15..584dd91 100644 --- a/library/manifest.txt +++ b/library/manifest.txt @@ -4,7 +4,7 @@ apply {{dir} { set isafe [interp issafe] foreach {safe package version file} { - 0 http 2.10b2 {http http.tcl} + 0 http 2.10b3 {http http.tcl} 1 msgcat 1.7.1 {msgcat msgcat.tcl} 1 opt 0.4.9 {opt optparse.tcl} 0 cookiejar 0.2.0 {cookiejar cookiejar.tcl} diff --git a/unix/Makefile.in b/unix/Makefile.in index 0495799..381fe24 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1075,9 +1075,9 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ done - @echo "Installing package http 2.10b2 as a Tcl Module" + @echo "Installing package http 2.10b3 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ - "$(MODULE_INSTALL_DIR)/9.0/http-2.10b2.tm" + "$(MODULE_INSTALL_DIR)/9.0/http-2.10b3.tm" @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/" @for i in $(TOP_DIR)/library/opt/*.tcl; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ diff --git a/unix/configure b/unix/configure index c8e5bdc..6a3d192 100755 --- a/unix/configure +++ b/unix/configure @@ -2710,7 +2710,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b2" +TCL_PATCH_LEVEL="b3" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/configure.ac b/unix/configure.ac index df38377..69c20f7 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -26,7 +26,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b2" +TCL_PATCH_LEVEL="b3" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/tcl.spec b/unix/tcl.spec index 65194f6..3b68691 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 9.0b2 +Version: 9.0b3 Release: 2 License: BSD Group: Development/Languages diff --git a/win/Makefile.in b/win/Makefile.in index 14e518e..ce09ade 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -929,8 +929,8 @@ install-libraries: libraries install-tzdata install-msgs $(ROOT_DIR)/library/cookiejar/*.gz; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ done; - @echo "Installing package http 2.10b2 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.10b2.tm"; + @echo "Installing package http 2.10b3 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.10b3.tm"; @echo "Installing package opt 0.4.7"; @for j in $(ROOT_DIR)/library/opt/*.tcl; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ diff --git a/win/configure b/win/configure index 103e114..8708050 100755 --- a/win/configure +++ b/win/configure @@ -2411,7 +2411,7 @@ SHELL=/bin/sh TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b2" +TCL_PATCH_LEVEL="b3" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/configure.ac b/win/configure.ac index 9f6e21a..83ed3af 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -15,7 +15,7 @@ SHELL=/bin/sh TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b2" +TCL_PATCH_LEVEL="b3" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 -- cgit v0.12 From 17a41bd55ea615808876767444e9027328d89660 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 21 May 2024 10:49:54 +0000 Subject: circumvent crash [7842f33a5cc5eed0] on null ptr (oPtr->selfCls may be NULL) --- generic/tclOOCall.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index c421cad..bac6518 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -930,7 +930,7 @@ AddSimpleChainToCallContext( contextCls, methodNameObj, cbPtr, doneFilters, flags, filterDecl); } - if (!blockedUnexported) { + if (!blockedUnexported && oPtr->selfCls) { foundPrivate |= AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr, doneFilters, flags, filterDecl); } -- cgit v0.12 From 58cdaeb15dc1162422b2998aa7700df724dcaf2d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 May 2024 14:05:46 +0000 Subject: Fix off-by-one error in tcl::build-info command. Improve spacing --- generic/tclBasic.c | 40 ++++++++++++++++++---------------------- 1 file changed, 18 insertions(+), 22 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index f84c277..2e6de71 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -753,8 +753,8 @@ buildInfoObjCmd( if (!strncmp(p, arg, len) && ((p[len] == '.') || (p[len] == '-') || (p[len] == '\0'))) { if (p[len] == '-') { - p += len + 2; - q = strchr(p, '.'); + p += len; + q = strchr(++p, '.'); if (!q) { q = p + strlen(p); } @@ -1579,8 +1579,8 @@ Tcl_CallWhenDeleted( { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; - int *assocDataCounterPtr = - (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); + int *assocDataCounterPtr = (int *) + Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; AssocData *dPtr = (AssocData *)ckalloc(sizeof(AssocData)); @@ -1988,7 +1988,6 @@ DeleteInterpProc( ckfree(hTablePtr); } - if (iPtr->assocData != NULL) { AssocData *dPtr; @@ -2856,7 +2855,7 @@ TclCreateObjCommandInNs( && cmdPtr->deleteProc == deleteProc) { cmdPtr->objProc = proc; cmdPtr->objClientData = clientData; - return (Tcl_Command) cmdPtr; + return (Tcl_Command)cmdPtr; } /* @@ -3364,7 +3363,7 @@ Tcl_SetCommandInfoFromToken( * The isNativeObjectProc and nsPtr members of *infoPtr are ignored. */ - cmdPtr = (Command *) cmd; + cmdPtr = (Command *)cmd; cmdPtr->proc = infoPtr->proc; cmdPtr->clientData = infoPtr->clientData; if (infoPtr->objProc == NULL) { @@ -3673,7 +3672,7 @@ Tcl_DeleteCommandFromToken( if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; /* CallCommandTraces() does not cmdPtr, that's - * done just before Tcl_DeleteCommandFromToken() returns */ + * done just before Tcl_DeleteCommandFromToken() returns */ CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); /* @@ -4941,14 +4940,14 @@ Dispatch( { Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0]; void *clientData = data[1]; - int objc = PTR2INT(data[2]); + Tcl_Size objc = PTR2INT(data[2]); Tcl_Obj **objv = (Tcl_Obj **)data[3]; Interp *iPtr = (Interp *) interp; #ifdef USE_DTRACE if (TCL_DTRACE_CMD_ARGS_ENABLED()) { const char *a[10]; - int i = 0; + Tcl_Size i = 0; while (i < 10) { a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++; @@ -5746,7 +5745,7 @@ TclEvalEx( */ if (numWords > minObjs) { - expand = (int *) ckalloc(numWords * sizeof(int)); + expand = (int *)ckalloc(numWords * sizeof(int)); objvSpace = (Tcl_Obj **) ckalloc(numWords * sizeof(Tcl_Obj *)); lineSpace = (Tcl_Size *) @@ -5835,10 +5834,8 @@ TclEvalEx( Tcl_Size objIdx = objectsNeeded - 1; if ((numWords > minObjs) || (objectsNeeded > minObjs)) { - objv = objvSpace = (Tcl_Obj **) - ckalloc(objectsNeeded * sizeof(Tcl_Obj *)); - lines = lineSpace = (Tcl_Size *) - ckalloc(objectsNeeded * sizeof(Tcl_Size)); + objv = objvSpace = (Tcl_Obj **)ckalloc(objectsNeeded * sizeof(Tcl_Obj *)); + lines = lineSpace = (Tcl_Size *)ckalloc(objectsNeeded * sizeof(Tcl_Size)); } objectsUsed = 0; @@ -6449,7 +6446,7 @@ TclArgumentGet( CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); framePtr = cfwPtr->framePtr; - framePtr->data.tebc.pc = (char *) (((ByteCode *) + framePtr->data.tebc.pc = (char *)(((ByteCode *) framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc); *cfPtrPtr = cfwPtr->framePtr; *wordPtr = cfwPtr->word; @@ -6495,7 +6492,7 @@ Tcl_Eval( * string result (some callers may expect it there). */ - (void) Tcl_GetStringResult(interp); + (void)Tcl_GetStringResult(interp); return code; } @@ -9483,7 +9480,7 @@ TclNRTailcallEval( TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; - return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL); + return TclNREvalObjv(interp, objc - 1, objv + 1, 0, NULL); } int @@ -9834,7 +9831,6 @@ TclNRCoroutineActivateCallback( } iPtr->execEnvPtr = corPtr->eePtr; - Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot yield: C stack busy", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", @@ -9869,7 +9865,7 @@ TclNRCoroutineActivateCallback( * * TclNREvalList -- * - * Callback to invoke command as list, used in order to delayed + * Callback to invoke command as list, used in order to delayed * processing of canonical list command in sane environment. * *---------------------------------------------------------------------- @@ -9898,7 +9894,7 @@ TclNREvalList( * * CoroTypeObjCmd -- * - * Implementation of [::tcl::unsupported::corotype] command. + * Implementation of [::tcl::unsupported::corotype] command. * *---------------------------------------------------------------------- */ @@ -9967,7 +9963,7 @@ CoroTypeObjCmd( * * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd -- * - * Implementation of [coroinject] and [coroprobe] commands. + * Implementation of [coroinject] and [coroprobe] commands. * *---------------------------------------------------------------------- */ -- cgit v0.12 From e01556bf87ef7ea1361222f93805c95d4a5c474a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 May 2024 19:50:55 +0000 Subject: Add tommath-????/zlib-???? to build-info if libtommath/zlib is statically linked --- generic/tclEvent.c | 14 ++++++++++++++ unix/configure | 3 +++ unix/configure.ac | 1 + unix/tclConfig.h.in | 3 +++ win/configure | 3 +++ win/configure.ac | 1 + win/makefile.vc | 4 ++++ 7 files changed, 29 insertions(+) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index e832422..79e7050 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1128,6 +1128,20 @@ static const struct { #ifdef STATIC_BUILD ".static" #endif +#ifndef TCL_WITH_EXTERNAL_TOMMATH + ".tommath-0103" +#endif +#ifdef TCL_WITH_INTERNAL_ZLIB + ".zlib-" +#if ZLIB_VER_MAJOR < 10 + "0" +#endif + STRINGIFY(ZLIB_VER_MAJOR) +#if ZLIB_VER_MINOR < 10 + "0" +#endif + STRINGIFY(ZLIB_VER_MINOR) +#endif }}; const char * diff --git a/unix/configure b/unix/configure index 092f19c..85e66bc 100755 --- a/unix/configure +++ b/unix/configure @@ -5205,6 +5205,9 @@ then : ZLIB_INCLUDE=-I\${ZLIB_DIR} +printf "%s\n" "#define TCL_WITH_INTERNAL_ZLIB 1" >>confdefs.h + + fi printf "%s\n" "#define HAVE_ZLIB 1" >>confdefs.h diff --git a/unix/configure.ac b/unix/configure.ac index a74d494..f1f66be 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -165,6 +165,7 @@ AS_IF([test $zlib_ok = no], [ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) AC_SUBST(ZLIB_SRCS,[\${ZLIB_SRCS}]) AC_SUBST(ZLIB_INCLUDE,[-I\${ZLIB_DIR}]) + AC_DEFINE(TCL_WITH_INTERNAL_ZLIB, 1, [Tcl with internal zlib]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index cc75c29..4b677c1 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -453,6 +453,9 @@ /* Tcl with external libtommath */ #undef TCL_WITH_EXTERNAL_TOMMATH +/* Tcl with internal zlib */ +#undef TCL_WITH_INTERNAL_ZLIB + /* Is getcwd Posix-compliant? */ #undef USEGETWD diff --git a/win/configure b/win/configure index 94e04f5..c783189 100755 --- a/win/configure +++ b/win/configure @@ -5044,6 +5044,9 @@ fi else case e in #( e) + +printf "%s\n" "#define TCL_WITH_INTERNAL_ZLIB 1" >>confdefs.h + ZLIB_OBJS=\${ZLIB_OBJS} TOMMATH_OBJS=\${TOMMATH_OBJS} diff --git a/win/configure.ac b/win/configure.ac index 25fa29f..f0288c7 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -169,6 +169,7 @@ AS_IF([test "$tcl_ok" = "yes"], [ AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win32/tommath.lib]) ]) ], [ + AC_DEFINE(TCL_WITH_INTERNAL_ZLIB, 1, [Tcl with internal zlib]) AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}]) ]) diff --git a/win/makefile.vc b/win/makefile.vc index b79e8ee..f1d1d84 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -471,6 +471,10 @@ LIBTCLVFS = $(OUT_DIR)\$(LIBTCLVFSSUBDIR) PRJ_INCLUDES = -I"$(TOMMATHDIR)" PRJ_DEFINES = /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS +!if $(STATIC_BUILD) +PRJ_DEFINES = $(PRJ_DEFINES) /DTCL_WITH_INTERNAL_ZLIB +!endif + # Additional Link libraries needed beyond those in rules.vc PRJ_LIBS = netapi32.lib user32.lib userenv.lib ws2_32.lib -- cgit v0.12 From 8db28167443e199a1c77d0afdeba625a48f11e0c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 May 2024 20:19:30 +0000 Subject: "TCL_TOMMATH" is not used anywhere --- unix/configure | 5 ----- unix/configure.in | 1 - unix/tclConfig.h.in | 3 --- win/Makefile.in | 4 ++-- win/makefile.vc | 2 +- 5 files changed, 3 insertions(+), 12 deletions(-) diff --git a/unix/configure b/unix/configure index d890135..370195d 100755 --- a/unix/configure +++ b/unix/configure @@ -9195,11 +9195,6 @@ echo "${ECHO_T}enabled $tcl_ok debugging" >&6 cat >>confdefs.h <<\_ACEOF -#define TCL_TOMMATH 1 -_ACEOF - - -cat >>confdefs.h <<\_ACEOF #define MP_PREC 4 _ACEOF diff --git a/unix/configure.in b/unix/configure.in index ca4145a..414693a 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -183,7 +183,6 @@ SC_CONFIG_CFLAGS SC_ENABLE_SYMBOLS(bccdebug) -AC_DEFINE(TCL_TOMMATH, 1, [Build libtommath?]) AC_DEFINE(MP_PREC, 4, [Default libtommath precision.]) #-------------------------------------------------------------------- diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 5a64236..c21bb54 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -426,9 +426,6 @@ /* Are we building with threads enabled? */ #undef TCL_THREADS -/* Build libtommath? */ -#undef TCL_TOMMATH - /* Do we allow unloading of shared libraries? */ #undef TCL_UNLOAD_DLLS diff --git a/win/Makefile.in b/win/Makefile.in index 1a8bd2d..3b89dd7 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -209,7 +209,7 @@ COPY = cp GDB = gdb CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \ --I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" -DTCL_TOMMATH \ +-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \ ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} @@ -217,7 +217,7 @@ CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ STUB_CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \ --I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" -DTCL_TOMMATH \ +-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \ ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} diff --git a/win/makefile.vc b/win/makefile.vc index 4d0bf70..5642155 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -424,7 +424,7 @@ PKGSDIR = $(ROOT)\pkgs # Additional include and C macro definitions for the implicit rules # defined in rules.vc PRJ_INCLUDES = -I"$(TOMMATHDIR)" -PRJ_DEFINES = /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS +PRJ_DEFINES = /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS # Additional Link libraries needed beyond those in rules.vc PRJ_LIBS = netapi32.lib user32.lib userenv.lib ws2_32.lib -- cgit v0.12 From ea6c7d941dbff0e4659841da5fb4954cb01f4d97 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 22 May 2024 09:09:21 +0000 Subject: Spacing/code cleanup, backported from 8.7 20:19:30 [4c1393b596] *CURRENT* "TCL_TOMMATH" is not used anywh --- unix/tclUnixPipe.c | 59 +++++++++++++++++++++++++++--------------------------- 1 file changed, 30 insertions(+), 29 deletions(-) diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 6e07a02..1a2129d 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -59,16 +59,16 @@ typedef struct PipeState { * Declarations for local functions defined in this file: */ -static int PipeBlockModeProc(ClientData instanceData, int mode); -static int PipeClose2Proc(ClientData instanceData, +static int PipeBlockModeProc(void *instanceData, int mode); +static int PipeClose2Proc(void *instanceData, Tcl_Interp *interp, int flags); -static int PipeGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); -static int PipeInputProc(ClientData instanceData, char *buf, +static int PipeGetHandleProc(void *instanceData, + int direction, void **handlePtr); +static int PipeInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int PipeOutputProc(ClientData instanceData, +static int PipeOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -static void PipeWatchProc(ClientData instanceData, int mask); +static void PipeWatchProc(void *instanceData, int mask); static void RestoreSignals(void); static int SetupStdFile(TclFile file, int type); @@ -118,7 +118,7 @@ TclpMakeFile( Tcl_Channel channel, /* Channel to get file from. */ int direction) /* Either TCL_READABLE or TCL_WRITABLE. */ { - ClientData data; + void *data; if (Tcl_GetChannelHandle(channel, direction, &data) != TCL_OK) { return NULL; @@ -164,7 +164,7 @@ TclpOpenFile( */ if ((mode & O_WRONLY) && !(mode & O_APPEND)) { - TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_END); + TclOSseek(fd, 0, SEEK_END); } /* @@ -216,7 +216,7 @@ TclpCreateTempFile( return NULL; } Tcl_DStringFree(&dstring); - TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_SET); + TclOSseek(fd, 0, SEEK_SET); } return MakeFile(fd); } @@ -507,12 +507,11 @@ TclpCreateProcess( sigdelset(&sigs, SIGKILL); sigdelset(&sigs, SIGSTOP); - posix_spawnattr_setflags(&attr, - POSIX_SPAWN_SETSIGDEF + posix_spawnattr_setflags(&attr, POSIX_SPAWN_SETSIGDEF #ifdef POSIX_SPAWN_USEVFORK - | POSIX_SPAWN_USEVFORK + | POSIX_SPAWN_USEVFORK #endif - ); + ); posix_spawnattr_setsigdefault(&attr, &sigs); posix_spawn_file_actions_adddup2(&actions, GetFd(inputFile), 0); @@ -520,7 +519,7 @@ TclpCreateProcess( posix_spawn_file_actions_adddup2(&actions, GetFd(errorFile), 2); status = posix_spawnp(&pid, newArgv[0], &actions, &attr, - newArgv, environ); + newArgv, environ); childErrno = errno; posix_spawn_file_actions_destroy(&actions); posix_spawnattr_destroy(&attr); @@ -621,7 +620,7 @@ TclpCreateProcess( } TclpCloseFile(errPipeIn); - *pidPtr = (Tcl_Pid) INT2PTR(pid); + *pidPtr = (Tcl_Pid)INT2PTR(pid); return TCL_OK; error: @@ -987,7 +986,7 @@ TclGetAndDetachPids( static int PipeBlockModeProc( - ClientData instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ @@ -1027,7 +1026,7 @@ PipeBlockModeProc( static int PipeClose2Proc( - ClientData instanceData, /* The pipe to close. */ + void *instanceData, /* The pipe to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { @@ -1122,7 +1121,7 @@ PipeClose2Proc( static int PipeInputProc( - ClientData instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ char *buf, /* Where to store data read. */ int toRead, /* How much space is available in the * buffer? */ @@ -1173,7 +1172,7 @@ PipeInputProc( static int PipeOutputProc( - ClientData instanceData, /* Pipe state. */ + void *instanceData, /* Pipe state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ @@ -1221,18 +1220,20 @@ PipeOutputProc( * so do not pass it to directly to Tcl_CreateFileHandler. * Instead, pass a wrapper which is a Tcl_FileProc. */ + static void PipeWatchNotifyChannelWrapper( - ClientData clientData, + void *clientData, int mask) { - Tcl_Channel channel = clientData; + Tcl_Channel channel = (Tcl_Channel)clientData; + Tcl_NotifyChannel(channel, mask); } static void PipeWatchProc( - ClientData instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1280,9 +1281,9 @@ PipeWatchProc( static int PipeGetHandleProc( - ClientData instanceData, /* The pipe state. */ + void *instanceData, /* The pipe state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { PipeState *psPtr = (PipeState *)instanceData; @@ -1325,7 +1326,7 @@ Tcl_WaitPid( while (1) { result = (int) waitpid(real_pid, statPtr, options); if ((result != -1) || (errno != EINTR)) { - return (Tcl_Pid) INT2PTR(result); + return (Tcl_Pid)INT2PTR(result); } } } @@ -1349,7 +1350,7 @@ Tcl_WaitPid( int Tcl_PidObjCmd( - ClientData dummy, /* Not used. */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -1365,13 +1366,13 @@ Tcl_PidObjCmd( } if (objc == 1) { - Tcl_SetObjResult(interp, Tcl_NewLongObj((long) getpid())); + Tcl_SetObjResult(interp, Tcl_NewLongObj((long)getpid())); } else { /* * Get the channel and make sure that it refers to a pipe. */ - chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); + chan = Tcl_GetChannel(interp, TclGetString(objv[1]), NULL); if (chan == NULL) { return TCL_ERROR; } -- cgit v0.12 From 810c251b8675bc0d663a126b5e845a0e989da1e0 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 22 May 2024 10:11:59 +0000 Subject: small amend to [1d16344c8cfaecc8], [7842f33a5cc5eed0]: don't need to invoke both functions in case if oPtr->selfCls is NULL --- generic/tclOOCall.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index bac6518..5fe20b3 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -925,12 +925,15 @@ AddSimpleChainToCallContext( } } } + if (!oPtr->selfCls) { + return foundPrivate; + } if (contextCls) { foundPrivate |= AddPrivatesFromClassChainToCallContext(oPtr->selfCls, contextCls, methodNameObj, cbPtr, doneFilters, flags, filterDecl); } - if (!blockedUnexported && oPtr->selfCls) { + if (!blockedUnexported) { foundPrivate |= AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr, doneFilters, flags, filterDecl); } -- cgit v0.12 From 02722c65b1098b395b4a17dbbab29372e39d09ee Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 22 May 2024 10:22:30 +0000 Subject: cherry-pick [659ca0ae8da43a1e] for 8.6: don't need to invoke it in case if oPtr->selfCls is NULL --- generic/tclOOCall.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index bfff4e9..512db60 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -756,6 +756,9 @@ AddSimpleChainToCallContext( } } } + if (!oPtr->selfCls) { + return; + } AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr, doneFilters, flags, filterDecl); } -- cgit v0.12 From e6919d022e5a1fa46781b0ea71ada683c5ee5e85 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 22 May 2024 10:50:01 +0000 Subject: amend to [de08cf03235f3ce9], [7842f33a5cc5eed0], stop tail recursion in AddSimpleClassChainToCallContext if classPtr is NULL --- generic/tclOOCall.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 5fe20b3..14e747c 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -1774,6 +1774,9 @@ AddSimpleClassChainToCallContext( */ tailRecurse: + if (classPtr == NULL) { + return privateDanger; + } FOREACH(superPtr, classPtr->mixins) { privateDanger |= AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN, -- cgit v0.12 From d82bf565c799c08e5eb5080e1cb49910272f1ade Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 22 May 2024 21:12:15 +0000 Subject: clock option re-ordering --- generic/tclClock.c | 37 +++++++++++++++++-------------------- generic/tclClockFmt.c | 8 ++++---- generic/tclStrIdxTree.c | 7 +++---- 3 files changed, 24 insertions(+), 28 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index c0fe59a..cbcacf2 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -83,8 +83,7 @@ static int ConvertLocalToUTCUsingTable(Tcl_Interp *, Tcl_WideInt *rangesVal); static int ConvertLocalToUTCUsingC(Tcl_Interp *, TclDateFields *, int); -static int ClockConfigureObjCmd(void *clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc ClockConfigureObjCmd; static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); @@ -941,7 +940,8 @@ TimezoneLoaded( * * ClockConfigureObjCmd -- * - * This function is invoked to process the Tcl "::clock::configure" (internal) command. + * This function is invoked to process the Tcl "::tcl::unsupported::clock::configure" + * (internal, unsupported) command. * * Usage: * ::tcl::unsupported::clock::configure ?-option ?value?? @@ -964,19 +964,16 @@ ClockConfigureObjCmd( { ClockClientData *dataPtr = (ClockClientData *)clientData; static const char *const options[] = { - "-system-tz", "-setup-tz", "-default-locale", "-current-locale", - "-clear", + "-default-locale", "-clear", "-current-locale", "-year-century", "-century-switch", "-min-year", "-max-year", "-max-jdn", "-validate", - "-init-complete", - NULL + "-init-complete", "-setup-tz", "-system-tz", NULL }; enum optionInd { - CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_DEFAULT_LOCALE, CLOCK_CURRENT_LOCALE, - CLOCK_CLEAR_CACHE, + CLOCK_DEFAULT_LOCALE, CLOCK_CLEAR_CACHE, CLOCK_CURRENT_LOCALE, CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH, CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_MAX_JDN, CLOCK_VALIDATE, - CLOCK_INIT_COMPLETE + CLOCK_INIT_COMPLETE, CLOCK_SETUP_TZ, CLOCK_SYSTEM_TZ }; int optionIndex; /* Index of an option. */ Tcl_Size i; @@ -4571,16 +4568,16 @@ ClockSafeCatchCmd( Tcl_Obj *const objv[]) { typedef struct { - int status; /* return code status */ - int flags; /* Each remaining field saves the */ - int returnLevel; /* corresponding field of the Interp */ - int returnCode; /* struct. These fields taken together are */ - Tcl_Obj *errorInfo; /* the "state" of the interp. */ - Tcl_Obj *errorCode; - Tcl_Obj *returnOpts; - Tcl_Obj *objResult; - Tcl_Obj *errorStack; - int resetErrorStack; + int status; /* return code status */ + int flags; /* Each remaining field saves the */ + int returnLevel; /* corresponding field of the Interp */ + int returnCode; /* struct. These fields taken together are */ + Tcl_Obj *errorInfo; /* the "state" of the interp. */ + Tcl_Obj *errorCode; + Tcl_Obj *returnOpts; + Tcl_Obj *objResult; + Tcl_Obj *errorStack; + int resetErrorStack; } InterpState; Interp *iPtr = (Interp *)interp; diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 9b32020..1c7461c 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -249,7 +249,7 @@ Clock_itoaw( val /= 10; *p-- = '0' + c; } while (val > 0); - /* fulling with pad-char */ + /* filling with pad-char */ while (p >= buf) { *p-- = padchar; } @@ -290,7 +290,7 @@ Clock_itoaw( if (padchar != '0') { *p-- = '-'; } - /* fulling with pad-char */ + /* filling with pad-char */ while (p >= buf + 1) { *p-- = padchar; } @@ -347,7 +347,7 @@ Clock_witoaw( val /= 10; *p-- = '0' + c; } while (val > 0); - /* fulling with pad-char */ + /* filling with pad-char */ while (p >= buf) { *p-- = padchar; } @@ -398,7 +398,7 @@ Clock_witoaw( if (padchar != '0') { *p-- = '-'; } - /* fulling with pad-char */ + /* filling with pad-char */ while (p >= buf + 1) { *p-- = padchar; } diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index 1c4cff3..e9ba362 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -479,16 +479,15 @@ TclStrIdxTreePrint( int TclStrIdxTreeTestObjCmd( - ClientData clientData, Tcl_Interp *interp, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *cs, *cin, *ret; static const char *const options[] = { - "index", "puts-index", "findequal", - NULL + "findequal", "index", "puts-index", NULL }; enum optionInd { - O_INDEX, O_PUTS_INDEX, O_FINDEQUAL + O_FINDEQUAL, O_INDEX, O_PUTS_INDEX }; int optionIndex; -- cgit v0.12 From 17dfb24e2fc42066c2873d8dddb2311db98fc862 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 22 May 2024 22:15:08 +0000 Subject: .travis.yml is not used any more --- .travis.yml | 367 ------------------------------------------------------- unix/Makefile.in | 1 - 2 files changed, 368 deletions(-) delete mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 061fe2d..0000000 --- a/.travis.yml +++ /dev/null @@ -1,367 +0,0 @@ -language: c -addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - binutils-mingw-w64-i686 - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64 - - gcc-mingw-w64-base - - gcc-mingw-w64-i686 - - gcc-mingw-w64-x86-64 - - gcc-multilib -jobs: - include: -# Testing on Linux GCC - - name: "Linux/GCC/Shared" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - name: "Linux/GCC/Shared: UTF_MAX=4" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_UTF_MAX=4 - - name: "Linux/GCC/Shared: UTF_MAX=6" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6 - - name: "Linux/GCC/Static" - os: linux - dist: focal - compiler: gcc - env: - - CFGOPT="--disable-shared" - - BUILD_DIR=unix - - name: "Linux/GCC/Debug" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols" - - name: "Linux/GCC/Mem-Debug" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols=mem" -# Newer/Older versions of GCC - - name: "Linux/GCC 10/Shared" - os: linux - dist: focal - compiler: gcc-10 - addons: - apt: - packages: - - g++-10 - env: - - BUILD_DIR=unix - - name: "Linux/GCC 5/Shared" - os: linux - dist: bionic - compiler: gcc-5 - addons: - apt: - packages: - - g++-5 - env: - - BUILD_DIR=unix -# Testing on Linux Clang - - name: "Linux/Clang/Shared" - os: linux - dist: focal - compiler: clang - env: - - BUILD_DIR=unix - - name: "Linux/Clang/Static" - os: linux - dist: focal - compiler: clang - env: - - CFGOPT="--disable-shared" - - BUILD_DIR=unix - - name: "Linux/Clang/Debug" - os: linux - dist: focal - compiler: clang - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols" - - name: "Linux/Clang/Mem-Debug" - os: linux - dist: focal - compiler: clang - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols=mem" -# Testing on Mac, various styles - - name: "macOS/Xcode 12/Shared" - os: osx - osx_image: xcode12.2 - env: - - BUILD_DIR=macosx - install: [] - script: &mactest - - make all - # The styles=develop avoids some weird problems on OSX - - make test styles=develop - - name: "macOS/Xcode 12/Shared/Unix-like" - os: osx - osx_image: xcode12.2 - env: - - BUILD_DIR=unix - - CFGOPT="--enable-dtrace" -# Newer MacOS versions - - name: "macOS/Xcode 12/Universal Apps/Shared" - os: osx - osx_image: xcode12u - env: - - BUILD_DIR=macosx - install: [] - script: *mactest -# Older MacOS versions - - name: "macOS/Xcode 11/Shared" - os: osx - osx_image: xcode11.7 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest - - name: "macOS/Xcode 10/Shared" - os: osx - osx_image: xcode10.3 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest - - name: "macOS/Xcode 9/Shared" - os: osx - osx_image: xcode9.4 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest - - name: "macOS/Xcode 8/Shared" - os: osx - osx_image: xcode8.3 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest -# Test with mingw-w64 cross-compile -# Doesn't run tests because wine is only an imperfect Windows emulation - - name: "Linux-cross-Windows/GCC/Shared/no test" - os: linux - dist: focal - compiler: x86_64-w64-mingw32-gcc - env: - - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" - script: &crosstest - - make all tcltest - # Include a high visibility marker that tests are skipped outright - - > - echo "`tput setaf 3`SKIPPED TEST: CROSS COMPILING`tput sgr0`" -# Test with mingw-w64 (32 bit) cross-compile -# Doesn't run tests because wine is only an imperfect Windows emulation - - name: "Linux-cross-Windows-32/GCC/Shared/no test" - os: linux - dist: focal - compiler: i686-w64-mingw32-gcc - env: - - BUILD_DIR=win - - CFGOPT=--host=i686-w64-mingw32 - script: *crosstest -# Test on Windows with MSVC native - - name: "Windows/MSVC/Shared" - os: windows - compiler: cl - env: &vcenv - - BUILD_DIR=win - - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build" - before_install: &vcpreinst - - touch generic/tclStubInit.c generic/tclOOStubInit.c - - PATH="$PATH:$VCDIR" - - cd ${BUILD_DIR} - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc test - - name: "Windows/MSVC/Static" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test - - name: "Windows/MSVC/StaticPackage" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc test - - name: "Windows/MSVC/Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test - - name: "Windows/MSVC/Mem-Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'STATS=memdbg' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'STATS=memdbg' '-f' makefile.vc test -# Test on Windows with MSVC native (32-bit) - - name: "Windows/MSVC-x86/Shared" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc test - - name: "Windows/MSVC-x86/Static" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test - - name: "Windows/MSVC-x86/Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test - - name: "Windows/MSVC-x86/Mem-Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'STATS=memdbg' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'STATS=memdbg' '-f' makefile.vc test -# Test on Windows with GCC native - - name: "Windows/GCC/Shared" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit" - before_install: &makepreinst - - touch generic/tclStubInit.c generic/tclOOStubInit.c - - choco install -y make - - cd ${BUILD_DIR} - - name: "Windows/GCC/Shared: UTF_MAX=4" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=4" - before_install: *makepreinst - - name: "Windows/GCC/Static" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit --disable-shared" - before_install: *makepreinst - - name: "Windows/GCC/Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit --enable-symbols" - before_install: *makepreinst - - name: "Windows/GCC/Mem-Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit --enable-symbols=mem" - before_install: *makepreinst -# Test on Windows with GCC native (32-bit) - - name: "Windows/GCC-x86/Shared" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - before_install: *makepreinst - - name: "Windows/GCC-x86/Shared: UTF_MAX=4" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="CFLAGS=-DTCL_UTF_MAX=4" - before_install: *makepreinst - - name: "Windows/GCC-x86/Static" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--disable-shared" - before_install: *makepreinst - - name: "Windows/GCC-x86/Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-symbols" - before_install: *makepreinst - - name: "Windows/GCC-x86/Mem-Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-symbols=mem" - before_install: *makepreinst -# "make dist" only - - name: "Linux: make dist" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - script: - - make dist -before_install: - - touch generic/tclStubInit.c generic/tclOOStubInit.c - - cd ${BUILD_DIR} -install: - - mkdir "$HOME/install dir" - - ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) -before_script: - - export ERROR_ON_FAILURES=1 -script: - - make all tcltest || echo "Something wrong, maybe a hickup, let's try again" - - make test - - make install diff --git a/unix/Makefile.in b/unix/Makefile.in index 814ec71..463d153 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2104,7 +2104,6 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in gen for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done - cp -p $(TOP_DIR)/.travis.yml $(DISTDIR) mkdir -p $(DISTDIR)/.github/workflows cp -p $(TOP_DIR)/.github/workflows/*.yml $(DISTDIR)/.github/workflows -- cgit v0.12 From b2668bd083be47f91ac264f42b3663c75ab33a88 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 23 May 2024 10:18:23 +0000 Subject: Possible fix for [3fc3287497]: TclGetProcessGlobalValue encodes information twice on Windows --- generic/tclUtil.c | 16 ++++++++++++---- win/tclWinSock.c | 25 +++++++++++-------------- 2 files changed, 23 insertions(+), 18 deletions(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 9cf594f..0c2f305 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -4212,6 +4212,7 @@ TclSetProcessGlobalValue( Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; int dummy; + Tcl_DString ds; Tcl_MutexLock(&pgvPtr->mutex); @@ -4226,8 +4227,11 @@ TclSetProcessGlobalValue( Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr); } bytes = TclGetStringFromObj(newValue, &pgvPtr->numBytes); + Tcl_UtfToExternalDString(encoding, bytes, pgvPtr->numBytes, &ds); + pgvPtr->numBytes = Tcl_DStringLength(&ds); pgvPtr->value = (char *)ckalloc(pgvPtr->numBytes + 1); - memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1); + memcpy(pgvPtr->value, Tcl_DStringValue(&ds), pgvPtr->numBytes + 1); + Tcl_DStringFree(&ds); if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); } @@ -4269,6 +4273,7 @@ TclGetProcessGlobalValue( Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; int epoch = pgvPtr->epoch; + Tcl_DString newValue; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -4280,7 +4285,7 @@ TclGetProcessGlobalValue( * system encoding. */ - Tcl_DString native, newValue; + Tcl_DString native; Tcl_MutexLock(&pgvPtr->mutex); epoch = ++pgvPtr->epoch; @@ -4330,10 +4335,13 @@ TclGetProcessGlobalValue( } /* - * Store a copy of the shared value in our epoch-indexed cache. + * Store a copy of the shared value (but then in utf-8) + * in our epoch-indexed cache. */ - value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); + Tcl_ExternalToUtfDString(NULL, pgvPtr->value, pgvPtr->numBytes, &newValue); + value = Tcl_NewStringObj(Tcl_DStringValue(&newValue), Tcl_DStringLength(&newValue)); + Tcl_DStringFree(&newValue); hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy); Tcl_MutexUnlock(&pgvPtr->mutex); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index df81c46..e077186 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -367,11 +367,14 @@ InitializeHostName( if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) { /* - * Convert string from native to UTF then change to lowercase. + * Convert string from WCHAR to utf-8, then change to lowercase, + * then to system encoding. */ + Tcl_DString inDs; - Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *)wbuf, -1, &ds)); - + Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *)wbuf, -1, &inDs)); + Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&inDs), -1, &ds); + Tcl_DStringFree(&inDs); } else { Tcl_DStringInit(&ds); if (TclpHasSockets(NULL) == TCL_OK) { @@ -380,20 +383,14 @@ InitializeHostName( * documents gethostname() as being always adequate. */ - Tcl_DString inDs; - - Tcl_DStringInit(&inDs); - Tcl_DStringSetLength(&inDs, 256); - if (gethostname(Tcl_DStringValue(&inDs), - Tcl_DStringLength(&inDs)) == 0) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), - -1, &ds); - } - Tcl_DStringFree(&inDs); + Tcl_DStringInit(&ds); + Tcl_DStringSetLength(&ds, 256); + gethostname(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); + Tcl_DStringSetLength(&ds, strlen(Tcl_DStringValue(&ds))); } } - *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); + *encodingPtr = Tcl_GetEncoding(NULL, NULL); *lengthPtr = Tcl_DStringLength(&ds); *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); -- cgit v0.12 From 2e1531179ae7fd22d1b1d7eedeb50c2c95a4ee3d Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 23 May 2024 11:27:05 +0000 Subject: Better flag up the oo::Slot class in the docs, add missing method [28d6013ae6] --- doc/define.n | 39 +++++++++++++++++++++++++++++++++------ 1 file changed, 33 insertions(+), 6 deletions(-) diff --git a/doc/define.n b/doc/define.n index ad991e1..4590bb1 100644 --- a/doc/define.n +++ b/doc/define.n @@ -9,7 +9,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -oo::define, oo::objdefine \- define and configure classes and objects +oo::define, oo::objdefine, oo::Slot \- define and configure classes and objects .SH SYNOPSIS .nf package require TclOO @@ -18,9 +18,15 @@ package require TclOO \fBoo::define\fI class subcommand arg\fR ?\fIarg ...\fR? \fBoo::objdefine\fI object defScript\fR \fBoo::objdefine\fI object subcommand arg\fR ?\fIarg ...\fR? + +\fBoo::Slot\fR \fIarg...\fR +.fi +.SH "CLASS HIERARCHY" +.nf +\fBoo::object\fR + \(-> \fBoo::Slot\fR .fi .BE - .SH DESCRIPTION The \fBoo::define\fR command is used to control the configuration of classes, and the \fBoo::objdefine\fR command is used to control the configuration of @@ -294,8 +300,10 @@ Some of the configurable definitions of a class or object are \fIslotted definitions\fR. This means that the configuration is implemented by a slot object, that is an instance of the class \fBoo::Slot\fR, which manages a list of values (class names, variable names, etc.) that comprises the contents of -the slot. The class defines three operations (as methods) that may be done on -the slot: +the slot. +.PP +The \fBoo::Slot\fR class defines three operations (as methods) that may be done +on the slot: .VE .TP \fIslot\fR \fB\-append\fR ?\fImember ...\fR? @@ -315,6 +323,10 @@ This replaces the slot definition with the given \fImember\fR elements. A consequence of this is that any use of a slot's default operation where the first member argument begins with a hyphen will be an error. One of the above operations should be used explicitly in those circumstances. +.PP +You only need to make an instance of \fBoo::Slot\fR if you are definining your +own slot that behaves like a standard slot. +.PP .SS "SLOT IMPLEMENTATION" Internally, slot objects also define a method \fB\-\-default\-operation\fR which is forwarded to the default operation of the slot (thus, for the class @@ -331,6 +343,15 @@ always be called from a stack frame created by a call to \fBoo::define\fR or \fBoo::objdefine\fR. .VE .TP +\fIslot\fR \fBResolve \fIelement\fR +.VS +This converts an element of the slotted collection into its resolved form; for +a simple value, it could just return the value, but for a slot that contains +references to commands or classes it should convert those into their +fully-qualified forms (so they can be compared with \fBstring equals\fR): that +could be done by forwarding to \fBnamespace which\fR or similar. +.VE +.TP \fIslot\fR \fBSet \fIelementList\fR .VS Sets the contents of the slot to the list \fIelementList\fR and returns the @@ -341,8 +362,14 @@ The implementation of these methods is slot-dependent (and responsible for accessing the correct part of the class or object definition). Slots also have an unknown method handler to tie all these pieces together, and they hide their \fBdestroy\fR method so that it is not invoked inadvertently. It is -\fIrecommended\fR that any user changes to the slot mechanism be restricted to -defining new operations whose names start with a hyphen. +\fIrecommended\fR that any user changes to the slot mechanism itself be +restricted to defining new operations whose names start with a hyphen. +.PP +Note that slot instances are not expected to contain the storage for the slot +they manage; that will be in or attached to the class or object that they +manage. Those instances should provide their own implementations of the +\fBGet\fR and \fBSet\fR methods (and optionally \fBResolve\fR; that defaults +to a do-nothing pass-through). .VE .SH EXAMPLES This example demonstrates how to use both forms of the \fBoo::define\fR and -- cgit v0.12 From 6bce591e1e7185c259f56514222025f0ac271dbe Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 23 May 2024 11:52:04 +0000 Subject: Fix 2 warnings on Win32 (Thanks, Harald). Some more code cleanup, backported from 8.7) --- generic/tclIO.c | 16 +++---- generic/tclStringObj.c | 125 ++++++++++++++++++++++++------------------------- 2 files changed, 67 insertions(+), 74 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 165a07e..55f3642 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -477,7 +477,7 @@ ChanSeek( if ((offset >= LONG_MIN) && (offset <= LONG_MAX)) { return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData, - offset, mode, errnoPtr); + (long)offset, mode, errnoPtr); } *errnoPtr = EOVERFLOW; return -1; @@ -6143,7 +6143,7 @@ ReadChars( if (dstLimit <= 0) { dstLimit = INT_MAX; /* avoid overflow */ } - (void) TclGetStringFromObj(objPtr, &numBytes); + (void)TclGetStringFromObj(objPtr, &numBytes); TclAppendUtfToUtf(objPtr, NULL, dstLimit); if (toRead == srcLen) { unsigned int size; @@ -8140,8 +8140,7 @@ Tcl_SetChannelOption( } else if (HaveOpt(2, "-eofchar")) { if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; - } - if (argc == 0) { + } else if (argc == 0) { statePtr->inEofChar = 0; statePtr->outEofChar = 0; } else if (argc == 1 || argc == 2) { @@ -9832,8 +9831,8 @@ CopyData( } /* - * Make the callback or return the number of bytes transferred. The - * local total is used because StopCopy frees csPtr. + * Make the callback or return the number of bytes transferred. The local + * total is used because StopCopy frees csPtr. */ total = csPtr->total; @@ -10662,8 +10661,7 @@ Tcl_ChannelVersion( * Side effects: * None. * - *---------------------------------------------------------------------- - */ + *---------------------------------------------------------------------- */ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( @@ -11063,7 +11061,7 @@ Tcl_SetChannelError( Tcl_Channel chan, /* Channel to store the data into. */ Tcl_Obj *msg) /* Error message to store. */ { - ChannelState *statePtr = ((Channel *) chan)->state; + ChannelState *statePtr = ((Channel *)chan)->state; if (statePtr->chanMsg != NULL) { TclDecrRefCount(statePtr->chanMsg); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index dcff811..55315f2 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1,34 +1,32 @@ /* * tclStringObj.c -- * - * This file contains functions that implement string operations on Tcl - * objects. Some string operations work with UTF strings and others - * require Unicode format. Functions that require knowledge of the width - * of each character, such as indexing, operate on Unicode data. - * - * A Unicode string is an internationalized string. Conceptually, a - * Unicode string is an array of 16-bit quantities organized as a - * sequence of properly formed UTF-8 characters. There is a one-to-one - * map between Unicode and UTF characters. Because Unicode characters - * have a fixed width, operations such as indexing operate on Unicode - * data. The String object is optimized for the case where each UTF char + * This file contains functions that implement string operations on Tcl + * objects. Some string operations work with UTF-8 encoding forms. + * Functions that require knowledge of the width of each character, + * such as indexing, operate on fixed width encoding forms such as UTF-16. + * + * Conceptually, a string is a sequence of Unicode code points. Internally + * it may be stored in an encoding form such as a modified version of + * UTF-8 or UTF-16. + * + * The String object is optimized for the case where each UTF char * in a string is only one byte. In this case, we store the value of - * numChars, but we don't store the Unicode data (unless Tcl_GetUnicode - * is explicitly called). + * numChars, but we don't store the fixed form encoding (unless + * Tcl_GetUnicode is explicitly called). * - * The String object type stores one or both formats. The default - * behavior is to store UTF. Once Unicode is calculated by a function, it - * is stored in the internal rep for future access (without an additional - * O(n) cost). + * The String object type stores one or both formats. The default + * behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is + * stored in the internal rep for future access (without an additional + * O(n) cost). * * To allow many appends to be done to an object without constantly - * reallocating the space for the string or Unicode representation, we - * allocate double the space for the string or Unicode and use the + * reallocating space, we allocate double the space and use the * internal representation to keep track of how much space is used vs. * allocated. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. - * Copyright (c) 1999 by Scriptics Corporation. + * Copyright (c) 1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -121,8 +119,8 @@ const Tcl_ObjType tclStringType = { static void GrowStringBuffer( Tcl_Obj *objPtr, - int needed, - int flag) + int needed, /* Not including terminating nul */ + int flag) /* If 0, try to overallocate */ { /* * Preconditions: @@ -238,7 +236,7 @@ GrowUnicodeBuffer( * * Side effects: * The new object's internal string representation will be set to a copy - * of the length bytes starting at "bytes". If "length" is negative, use + * of the length bytes starting at "bytes". If "length" is -1, use * bytes up to the first NUL byte; i.e., assume "bytes" points to a * C-style NUL-terminated string. The object's type is set to NULL. An * extra NUL is added to the end of the new object's byte array. @@ -252,9 +250,9 @@ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length) /* The number of bytes to copy from "bytes" + int length) /* The number of bytes to copy from "bytes" * when initializing the new object. If - * negative, use bytes up to the first NUL + * -1, use bytes up to the first NUL * byte. */ { return Tcl_DbNewStringObj(bytes, length, "unknown", 0); @@ -265,7 +263,7 @@ Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ int length) /* The number of bytes to copy from "bytes" - * when initializing the new object. If negative, + * when initializing the new object. If -1, * use bytes up to the first NUL byte. */ { Tcl_Obj *objPtr; @@ -299,7 +297,7 @@ Tcl_NewStringObj( * * Side effects: * The new object's internal string representation will be set to a copy - * of the length bytes starting at "bytes". If "length" is negative, use + * of the length bytes starting at "bytes". If "length" is -1, use * bytes up to the first NUL byte; i.e., assume "bytes" points to a * C-style NUL-terminated string. The object's type is set to NULL. An * extra NUL is added to the end of the new object's byte array. @@ -313,7 +311,7 @@ Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ int length, /* The number of bytes to copy from "bytes" - * when initializing the new object. If negative, + * when initializing the new object. If -1, * use bytes up to the first NUL byte. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ @@ -334,10 +332,9 @@ Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length, /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first NUL - * byte. */ + int length, /* The number of bytes to copy from "bytes" + * when initializing the new object. If -1, + * use bytes up to the first NUL byte. */ 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 @@ -415,7 +412,7 @@ Tcl_GetCharLength( } /* - * Optimize the case where we're really dealing with a ByteArray object; + * Optimize the case where we're really dealing with a bytearray object; * we don't need to convert to a string to perform the get-length operation. * * NOTE that we do not need the ByteArray to be "pure". A ByteArray value @@ -468,7 +465,7 @@ Tcl_GetCharLength( *---------------------------------------------------------------------- */ int -TclCheckEmptyString ( +TclCheckEmptyString( Tcl_Obj *objPtr) { int length = -1; @@ -723,9 +720,9 @@ Tcl_GetUnicodeFromObj( * * Create a Tcl Object that contains the chars between first and last of * the object indicated by "objPtr". If the object is not already a - * String object, convert it to one. If first is negative, the + * String object, convert it to one. If first is -1, the * returned string start at the beginning of objPtr. If last is - * negative, the returned string ends at the end of objPtr. + * -1, the returned string ends at the end of objPtr. * * Results: * Returns a new Tcl Object of the String type. @@ -751,7 +748,7 @@ Tcl_GetRange( } /* - * Optimize the case where we're really dealing with a ByteArray object + * Optimize the case where we're really dealing with a bytearray object * we don't need to convert to a string to perform the substring operation. */ @@ -805,7 +802,6 @@ Tcl_GetRange( FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } - if (last < 0 || last >= stringPtr->numChars) { last = stringPtr->numChars - 1; } @@ -841,7 +837,7 @@ Tcl_GetRange( * * Side effects: * The object's string representation will be set to a copy of the - * "length" bytes starting at "bytes". If "length" is negative, use bytes + * "length" bytes starting at "bytes". If "length" is -1, use bytes * up to the first NUL byte; i.e., assume "bytes" points to a C-style * NUL-terminated string. The object's old string and internal * representations are freed and the object's type is set NULL. @@ -854,8 +850,8 @@ Tcl_SetStringObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ const char *bytes, /* Points to the first of the length bytes * used to initialize the object. */ - int length) /* The number of bytes to copy from "bytes" - * when initializing the object. If negative, + int length) /* The number of bytes to copy from "bytes" + * when initializing the object. If -1, * use bytes up to the first NUL byte.*/ { if (Tcl_IsShared(objPtr)) { @@ -891,12 +887,11 @@ Tcl_SetStringObj( * None. * * Side effects: - * If the size of objPtr's string representation is greater than length, - * then it is reduced to length and a new terminating null byte is stored - * in the strength. If the length of the string representation is greater - * than length, the storage space is reallocated to the given length; a - * null byte is stored at the end, but other bytes past the end of the - * original string representation are undefined. + * If the size of objPtr's string representation is greater than length, a + * new terminating null byte is stored in objPtr->bytes at length, and + * bytes at positions past length have no meaning. If the length of the + * string representation is greater than length, the storage space is + * reallocated to length+1. * * The object's internal representation is changed to &tclStringType. * @@ -907,7 +902,7 @@ void Tcl_SetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - int length) /* Number of bytes desired for string + int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { @@ -1007,7 +1002,7 @@ int Tcl_AttemptSetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - int length) /* Number of bytes desired for string + int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { @@ -1195,10 +1190,10 @@ Tcl_AppendLimitedToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ - int length, /* The number of bytes available to be - * appended from "bytes". If < 0, then all - * bytes up to a NUL byte are available. */ - int limit, /* The maximum number of bytes to append to + int length, /* The number of bytes available to be + * appended from "bytes". If -1, then + * all bytes up to a NUL byte are available. */ + int limit, /* The maximum number of bytes to append to * the object. */ const char *ellipsis) /* Ellipsis marker string, appended to the * object to indicate not all available bytes @@ -1507,7 +1502,7 @@ static void AppendUnicodeToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to append. */ - int appendNumChars) /* Number of chars of "unicode" to append. */ + int appendNumChars) /* Number of chars of "unicode" to append. */ { String *stringPtr; int numChars; @@ -1596,7 +1591,7 @@ static void AppendUnicodeToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to convert to UTF. */ - int numChars) /* Number of chars of unicode to convert. */ + int numChars) /* Number of chars of Unicode to convert. */ { String *stringPtr = GET_STRING(objPtr); @@ -1876,7 +1871,7 @@ Tcl_AppendFormatToObj( if (Tcl_IsShared(appendObj)) { Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); } - TclGetStringFromObj(appendObj, &originalLength); + (void)TclGetStringFromObj(appendObj, &originalLength); limit = INT_MAX - originalLength; /* @@ -2347,7 +2342,7 @@ Tcl_AppendFormatToObj( uw /= base; } #endif - } else if (useBig && big.used) { + } else if (useBig && !mp_iszero(&big)) { int leftover = (big.used * MP_DIGIT_BIT) % numBits; mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover); @@ -2380,13 +2375,13 @@ Tcl_AppendFormatToObj( numDigits = 1; } TclNewObj(pure); - Tcl_SetObjLength(pure, numDigits); + Tcl_SetObjLength(pure, (int)numDigits); bytes = TclGetString(pure); toAppend = length = numDigits; while (numDigits--) { int digitOffset; - if (useBig && big.used) { + if (useBig && !mp_iszero(&big)) { if (index < big.used && (size_t) shift < CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) { bits |= ((Tcl_WideUInt) big.dp[index++]) << shift; @@ -2535,7 +2530,7 @@ Tcl_AppendFormatToObj( } } - TclGetStringFromObj(segment, &segmentNumBytes); + (void)TclGetStringFromObj(segment, &segmentNumBytes); if (segmentNumBytes > limit) { if (allocSegment) { Tcl_DecrRefCount(segment); @@ -2878,9 +2873,9 @@ TclGetStringStorage( * Implements the [string reverse] operation. * * Results: - * An unshared Tcl value which is the [string reverse] of the argument - * supplied. When sharing rules permit, the returned value might be the - * argument with modifications done in place. + * A Tcl value which is the [string reverse] of the argument supplied. + * When sharing rules permit and the caller requests, the returned value + * might be the argument with modifications done in place. * * Side effects: * May allocate a new Tcl_Obj. @@ -2892,7 +2887,7 @@ static void ReverseBytes( unsigned char *to, /* Copy bytes into here... */ unsigned char *from, /* ...from here... */ - int count) /* Until this many are copied, */ + int count) /* Until this many are copied, */ /* reversing as you go. */ { unsigned char *src = from + count; @@ -3109,7 +3104,7 @@ ExtendUnicodeRepWithString( } else { numAppendChars = 0; } - for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) { + for (dst = stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) { bytes += TclUtfToUniChar(bytes, &unichar); *dst = unichar; } -- cgit v0.12