-- 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 f7b4c00c2817d11f545b2bbf7ee60e6567ab169c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 18 Apr 2024 15:32:16 +0000 Subject: Fix [18f4a94d03] by backing out [9bcec7cd880540c3] (again) --- generic/tclIO.c | 87 ++++++++++++---------------------------------------- generic/tclIORChan.c | 66 ++++----------------------------------- tests/ioCmd.test | 40 ++---------------------- 3 files changed, 27 insertions(+), 166 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 0d8d4db..92b8b62 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -167,7 +167,6 @@ static int CheckForDeadChannel(Tcl_Interp *interp, static void CheckForStdChannelsBeingClosed(Tcl_Channel chan); static void CleanupChannelHandlers(Tcl_Interp *interp, Channel *chanPtr); -static void CleanupTimerHandler(ChannelState *statePtr); static int CloseChannel(Tcl_Interp *interp, Channel *chanPtr, int errorCode); static int CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr, @@ -3194,8 +3193,8 @@ CloseChannel( /* * Cancel any outstanding timer. */ - DeleteTimerHandler(statePtr); + DeleteTimerHandler(statePtr); /* * Mark the channel as deleted by clearing the type structure. @@ -3545,11 +3544,6 @@ Tcl_Close( Tcl_ClearChannelHandlers(chan); /* - * Cancel any outstanding timer. - */ - DeleteTimerHandler(statePtr); - - /* * Invoke the registered close callbacks and delete their records. */ @@ -7626,7 +7620,6 @@ Tcl_Eof( return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0; } - /* *---------------------------------------------------------------------- * @@ -7652,7 +7645,7 @@ TclChannelGetBlockingMode( return GotFlag(statePtr, CHANNEL_NONBLOCKING) ? 0 : 1; } - + /* *---------------------------------------------------------------------- * @@ -8760,7 +8753,6 @@ UpdateInterest( { ChannelState *statePtr = chanPtr->state; /* State info for channel */ - ChannelBuffer *bufPtr = statePtr->outQueueHead; int mask = statePtr->interestMask; if (chanPtr->typePtr == NULL) { @@ -8838,20 +8830,6 @@ UpdateInterest( } } } - - if (!statePtr->timer - && (mask & TCL_WRITABLE) - && GotFlag(statePtr, CHANNEL_NONBLOCKING) - && bufPtr - && !IsBufferEmpty(bufPtr) - && !IsBufferFull(bufPtr) - ) { - TclChannelPreserve((Tcl_Channel)chanPtr); - statePtr->timerChanPtr = chanPtr; - statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc,chanPtr); - } - ChanWatch(chanPtr, mask); } @@ -8880,51 +8858,30 @@ ChannelTimerProc( /* State info for channel */ ChannelState *statePtr = chanPtr->state; - /* TclChannelPreserve() must be called before the current function was - * scheduled, is already in effect. In this function it guards against - * deallocation in Tcl_NotifyChannel and also keps the channel preserved - * until ChannelTimerProc is later called again. - */ - if (chanPtr->typePtr == NULL) { - CleanupTimerHandler(statePtr); - } else { - Tcl_Preserve(statePtr); statePtr->timer = NULL; - if (statePtr->interestMask & TCL_WRITABLE - && GotFlag(statePtr, CHANNEL_NONBLOCKING) - && !GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { + TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); + statePtr->timerChanPtr = NULL; + } else { + if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) + && (statePtr->interestMask & TCL_READABLE) + && (statePtr->inQueueHead != NULL) + && IsBufferReady(statePtr->inQueueHead)) { /* * Restart the timer in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. */ statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, ChannelTimerProc,chanPtr); - Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE); + Tcl_Preserve(statePtr); + Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); + Tcl_Release(statePtr); } else { - /* The channel may have just been closed from within Tcl_NotifyChannel */ - if (!GotFlag(statePtr, CHANNEL_INCLOSE)) { - if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) - && (statePtr->interestMask & TCL_READABLE) - && (statePtr->inQueueHead != NULL) - && IsBufferReady(statePtr->inQueueHead)) { - /* - * Restart the timer in case a channel handler reenters the event loop - * before UpdateInterest gets called by Tcl_NotifyChannel. - */ - - statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc,chanPtr); - Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); - } else { - CleanupTimerHandler(statePtr); - UpdateInterest(chanPtr); - } - } else { - CleanupTimerHandler(statePtr); - } + statePtr->timer = NULL; + UpdateInterest(chanPtr); + TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); + statePtr->timerChanPtr = NULL; } - Tcl_Release(statePtr); } } @@ -8935,17 +8892,11 @@ DeleteTimerHandler( { if (statePtr->timer != NULL) { Tcl_DeleteTimerHandler(statePtr->timer); - CleanupTimerHandler(statePtr); + statePtr->timer = NULL; + TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); + statePtr->timerChanPtr = NULL; } } -static void -CleanupTimerHandler( - ChannelState *statePtr -){ - TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); - statePtr->timer = NULL; - statePtr->timerChanPtr = NULL; -} /* *---------------------------------------------------------------------- diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 4e938ae..d284f15 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -58,8 +58,6 @@ static int ReflectSetOption(void *clientData, const char *newValue); static int ReflectTruncate(void *clientData, long long length); -static void TimerRunRead(void *clientData); -static void TimerRunWrite(void *clientData); /* * The C layer channel type/driver definition used by the reflection. @@ -121,17 +119,6 @@ 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 - */ - /* * Note regarding the usage of timers. * @@ -141,9 +128,11 @@ typedef struct { * * See 'refchan', 'memchan', etc. * - * A timer is used here as well in order to ensure at least on pass through - * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and - * ef28eb1f1516. + * Here this is _not_ required. Interest in events is posted to the Tcl + * level via 'watch'. And posting of events is possible from the Tcl level + * as well, via 'chan postevent'. This means that the generation of all + * events, fake or not, timer based or not, is completely in the hands of + * the Tcl level. Therefore no timer here. */ } ReflectedChannel; @@ -959,18 +948,7 @@ TclChanPostEventObjCmd( #if TCL_THREADS if (rcPtr->owner == rcPtr->thread) { #endif - if (events & TCL_READABLE) { - if (rcPtr->readTimer == NULL) { - rcPtr->readTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - TimerRunRead, rcPtr); - } - } - if (events & TCL_WRITABLE) { - if (rcPtr->writeTimer == NULL) { - rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - TimerRunWrite, rcPtr); - } - } + Tcl_NotifyChannel(chan, events); #if TCL_THREADS } else { ReflectEvent *ev = (ReflectEvent *)ckalloc(sizeof(ReflectEvent)); @@ -1018,24 +996,6 @@ TclChanPostEventObjCmd( #undef EVENT } -static void -TimerRunRead( - void *clientData) -{ - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; - rcPtr->readTimer = NULL; - Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE); -} - -static void -TimerRunWrite( - void *clientData) -{ - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; - rcPtr->writeTimer = NULL; - Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE); -} - /* * Channel error message marshalling utilities. */ @@ -1234,12 +1194,6 @@ ReflectClose( ckfree(tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } - if (rcPtr->readTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->readTimer); - } - if (rcPtr->writeTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->writeTimer); - } Tcl_EventuallyFree(rcPtr, FreeReflectedChannel); return EOK; } @@ -1309,12 +1263,6 @@ ReflectClose( ckfree(tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } - if (rcPtr->readTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->readTimer); - } - if (rcPtr->writeTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->writeTimer); - } Tcl_EventuallyFree(rcPtr, FreeReflectedChannel); return (result == TCL_OK) ? EOK : EINVAL; } @@ -2280,8 +2228,6 @@ NewReflectedChannel( rcPtr->chan = NULL; rcPtr->interp = interp; rcPtr->dead = 0; - rcPtr->readTimer = 0; - rcPtr->writeTimer = 0; #if TCL_THREADS rcPtr->thread = Tcl_GetCurrentThread(); #endif diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 91e53fe..4400c56 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -985,17 +985,6 @@ proc onfinal {} { if {[lindex $hargs 0] ne "finalize"} {return} return -code return "" } - -proc onwatch {} { - upvar args hargs - lassign $hargs watch chan eventspec - if {$watch ne "watch"} return - foreach spec $eventspec { - chan postevent $chan $spec - } - return -} - } # Set everything up in the main thread. @@ -2077,7 +2066,7 @@ test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body { close $c rename foo {} set res -} -result {{watch rc* read} {} {} TOCK {watch rc* {}}} +} -result {{watch rc* read} {} TOCK {} {watch rc* {}}} test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} @@ -2090,7 +2079,7 @@ test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body { close $c rename foo {} set res -} -result {{watch rc* write} {} {} TOCK {watch rc* {}}} +} -result {{watch rc* write} {} TOCK {} {watch rc* {}}} test iocmd-31.8 {chan postevent after close throws error} -match glob -setup { proc foo {args} {oninit; onfinal; track; return} proc dummy args { return } @@ -2103,31 +2092,6 @@ test iocmd-31.8 {chan postevent after close throws error} -match glob -setup { rename foo {} rename dummy {} } -returnCodes error -result {can not find reflected channel named "rc*"} -test iocmd-31.9 { - chan postevent - - call to current coroutine - - see 67a5eabbd3d1 -} -match glob -body { - set res {} - proc foo {args} {oninit; onwatch; onfinal; track; return} - set c [chan create {r w} foo] - after 0 [list ::apply [list c { - coroutine c1 ::apply [list c { - chan event $c readable [list [info coroutine]] - yield - set ::done READING - } [namespace current]] $c - } [namespace current]] $c] - set stop [after 10000 {set done TIMEOUT}] - vwait ::done - catch {after cancel $stop} - lappend res $done - close $c - rename foo {} - set res -} -result {{watch rc* read} READING {watch rc* {}}} # --- === *** ########################### # 'Pull the rug' tests. Create channel in a interpreter A, move to -- 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 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 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 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 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 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 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 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 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 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 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 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 44c29862ccca2d251d85047622dca7efe4268721 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 24 May 2024 15:13:10 +0000 Subject: Fix [e589d9bdab] --- win/tclWinSock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 761023b..c05f550 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1378,7 +1378,7 @@ TcpGetOptionProc( reverseDNS = NI_NUMERICHOST; } - if (HAVE_OPTION("-peername")) { + if ((len == 0) || HAVE_OPTION("-peername")) { address peername; socklen_t size = sizeof(peername); -- cgit v0.12 From e1036ec626a90838228776217c00ccd308939a9d Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 24 May 2024 15:19:13 +0000 Subject: Add test for [e589d9bdab] --- tests/socket.test | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/socket.test b/tests/socket.test index b628404..2f71d7b 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -1110,6 +1110,25 @@ test socket_$af-7.5 {testing socket specific options} -setup { close $s close $s1 } -result [list $localhost 1 3] +test socket_$af-7.6 {testing socket specific options - bug e589d9bdab} -setup { + set timer [after 10000 "set x timed_out"] + set l "" +} -constraints [list socket supported_$af unixOrWin] -body { + set s [socket -server accept 0] + proc accept {s a p} { + global x + set x [fconfigure $s -sockname] + close $s + } + set listen [lindex [fconfigure $s -sockname] 2] + set s1 [socket $localhost $listen] + vwait x + lsort [dict keys [fconfigure $s1]] +} -cleanup { + after cancel $timer + close $s + close $s1 +} -result {-blocking -buffering -buffersize -encoding -eofchar -keepalive -nodelay -peername -profile -sockname -translation} test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket supported_$af] -body { # NOTE: This test may fail on some Solaris 2.4 systems. If it does, check -- cgit v0.12 From a6ab10a182d00fa11a958b7ba22a319822973444 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 24 May 2024 16:22:18 +0000 Subject: Tests for bug fixes --- tests/io.test | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 73 insertions(+), 6 deletions(-) diff --git a/tests/io.test b/tests/io.test index 49c16b7..a41e56b 100644 --- a/tests/io.test +++ b/tests/io.test @@ -6253,21 +6253,27 @@ test io-44.5 {FileEventProc procedure: end of file} -constraints { close $f +# Bug https://core.tcl-lang.org/tcl/info/de232b49f26da1c1 with a corrected +# refchan implementation. refchans should be responsible for their own +# event generation and the one in the bug report was not doing so. test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup { -} -constraints {stdio fileevent openpipe} -body { +} -constraints {stdio fileevent} -body { namespace eval refchan { namespace ensemble create namespace export * - + # Change to taste depending on how much CPU you want to hog + variable delay 0 proc finalize {chan args} { + namespace upvar c_$chan timer timer + catch {after cancel $timer} namespace delete c_$chan } proc initialize {chan args} { namespace eval c_$chan {} - namespace upvar c_$chan watching watching + namespace upvar c_$chan watching watching timer timer set watching {} list finalize initialize seek watch write } @@ -6281,17 +6287,37 @@ test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup { if {$arg ni $watching} { lappend watching $arg } - chan postevent $chan $arg } } } + update $chan } - proc write {chan args} { - chan postevent $chan write return 1 } + + # paraphrased from tcllib + proc update {chan} { + namespace upvar c_$chan watching watching timer timer + variable delay + catch {after cancel $timer} + if {"write" in $watching} { + set timer [after idle after $delay \ + [namespace code [list post $chan]]] + } + } + + # paraphrased from tcllib + proc post {chan} { + variable delay + namespace upvar c_$chan watching watching timer timer + if {"write" in $watching} { + set timer [after idle after $delay \ + [namespace code [list post $chan]]] + chan postevent $chan write + } + } } set f [chan create w [namespace which refchan]] chan configure $f -blocking 0 @@ -6315,6 +6341,47 @@ test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup { catch {chan close $f} } -result done +# Bug https://core.tcl-lang.org/tcl/info/67a5eabbd3d1 with a corrected +# refchan implementation. refchans that are not reentrant should use +# event loop to post events and the script in the bug report was not +# doing so. +test io-44.7 {refchan + coroutine yield error } -setup { + set bghandler [interp bgerror {}] + namespace eval schan { + namespace ensemble create + namespace export * + proc open {} { + set chan [chan create read [namespace current]] + + } + proc initialize {chan mode} { + return [list initialize finalize read watch] + } + + proc read {chan count} { + } + + proc watch {chan eventspec} { + after idle after 0 chan postevent $chan $eventspec + } + } +} -cleanup { + interp bgerror {} $bghandler + unset -nocomplain ::io-44.7-result + namespace delete schan +} -body { + interp bgerror {} [list apply {{res opts} { + set ::io-44.7-result [dict get $opts -errorinfo] + }}] + coroutine c1 apply [list {} { + set chan [schan::open] + chan event $chan readable [list [info coroutine]] + yield + set ::io-44.7-result success + } [namespace current]] + vwait ::io-44.7-result + set ::io-44.7-result +} -result success makeFile "foo bar" foo -- cgit v0.12 From c93d5f617e0aca98a24b1b88a864a07974c61254 Mon Sep 17 00:00:00 2001 From: griffin Date: Fri, 24 May 2024 17:50:38 +0000 Subject: address ticket [43b7e5b511] - Improve zipfs description in tclsh manual. --- doc/tclsh.1 | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/doc/tclsh.1 b/doc/tclsh.1 index 91df79d..c75076f 100644 --- a/doc/tclsh.1 +++ b/doc/tclsh.1 @@ -158,14 +158,22 @@ incomplete commands. See \fBTcl_StandardChannels\fR for more explanations. .SH ZIPVFS .PP -When a zipfile is concatenated to the end of a \fBtclsh\fR, on -startup the contents of the zip archive will be mounted as the -virtual file system /zvfs. If a top level directory tcl8.6 is -present in the zip archive, it will become the directory loaded -as env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present -in the top level directory of the zip archive, it will be sourced -instead of the shell's normal command line handing. +When a zipfile is concatenated to the end of a \fBtclsh\fR, on startup +the contents of the zip archive will be mounted under the virtual file +system \fB//zipfs:/\fR. If a top level directory \fBtcl_library\fR is +present in the zip archive, it will become the directory loaded as +env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present in the top +level directory of the zip archive, it will be sourced instead of the +shell's normal command line handing. +.PP +Only one zipfile can be concatenated to the end of executable image +(tclsh, or wish). However, if multiple zipfiles are +concatenated, only the last one is used. + +This filesystem is read-only. Files cannot be added or modified within +this mounted file system. See zipfs(n) for complete details. + .SH "SEE ALSO" -auto_path(n), encoding(n), env(n), fconfigure(n) +auto_path(n), encoding(n), env(n), fconfigure(n), zipfs(n) .SH KEYWORDS -application, argument, interpreter, prompt, script file, shell +application, argument, interpreter, prompt, script file, shell, zipfs -- cgit v0.12 From d074c70e9eb90a11545b4bf3bd4cb6d6bbc8acac Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 24 May 2024 22:14:08 +0000 Subject: Remove TclSetProcessGlobalValue() "encoding" parameter: it should always be NULL --- generic/tclEncoding.c | 8 ++++---- generic/tclInt.h | 2 +- generic/tclUtil.c | 13 +++++++------ 3 files changed, 12 insertions(+), 11 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 0844303..73b4f54 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -407,7 +407,7 @@ Tcl_SetEncodingSearchPath( if (TCL_ERROR == TclListObjLength(NULL, searchPath, &dummy)) { return TCL_ERROR; } - TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL); + TclSetProcessGlobalValue(&encodingSearchPath, searchPath); return TCL_OK; } @@ -482,7 +482,7 @@ FillEncodingFileMap(void) Tcl_DecrRefCount(directory); } Tcl_DecrRefCount(searchPath); - TclSetProcessGlobalValue(&encodingFileMap, map, NULL); + TclSetProcessGlobalValue(&encodingFileMap, map); Tcl_DecrRefCount(map); } @@ -1778,7 +1778,7 @@ OpenEncodingFileChannel( map = Tcl_DuplicateObj(map); Tcl_DictObjRemove(NULL, map, nameObj); - TclSetProcessGlobalValue(&encodingFileMap, map, NULL); + TclSetProcessGlobalValue(&encodingFileMap, map); directory = NULL; } } @@ -1812,7 +1812,7 @@ OpenEncodingFileChannel( map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap)); Tcl_DictObjPut(NULL, map, nameObj, dir[i]); - TclSetProcessGlobalValue(&encodingFileMap, map, NULL); + TclSetProcessGlobalValue(&encodingFileMap, map); } } diff --git a/generic/tclInt.h b/generic/tclInt.h index ed8336b..938090c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3576,7 +3576,7 @@ MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr); MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, - Tcl_Obj *newValue, Tcl_Encoding encoding); + Tcl_Obj *newValue); MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result); MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size subIdx, diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0fcecbf..e2c96a9 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -4121,8 +4121,7 @@ FreeProcessGlobalValue( void TclSetProcessGlobalValue( ProcessGlobalValue *pgvPtr, - Tcl_Obj *newValue, - Tcl_Encoding encoding) + Tcl_Obj *newValue) { const char *bytes; Tcl_HashTable *cacheMap; @@ -4144,7 +4143,7 @@ TclSetProcessGlobalValue( } bytes = TclGetString(newValue); pgvPtr->numBytes = newValue->length; - Tcl_UtfToExternalDStringEx(NULL, encoding, bytes, pgvPtr->numBytes, + Tcl_UtfToExternalDStringEx(NULL, NULL, bytes, pgvPtr->numBytes, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); pgvPtr->numBytes = Tcl_DStringLength(&ds); pgvPtr->value = (char *)Tcl_Alloc(pgvPtr->numBytes + 1); @@ -4153,7 +4152,7 @@ TclSetProcessGlobalValue( if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); } - pgvPtr->encoding = encoding; + pgvPtr->encoding = NULL; /* * Fill the local thread copy directly with the Tcl_Obj value to avoid @@ -4277,6 +4276,8 @@ TclGetProcessGlobalValue( * This function stores the absolute pathname of the executable file * (normally as computed by TclpFindExecutable). * + * Starting with Tcl 9.0, encoding parameter is not used any more. + * * Results: * None. * @@ -4289,9 +4290,9 @@ TclGetProcessGlobalValue( void TclSetObjNameOfExecutable( Tcl_Obj *name, - Tcl_Encoding encoding) + TCL_UNUSED(Tcl_Encoding)) { - TclSetProcessGlobalValue(&executableName, name, encoding); + TclSetProcessGlobalValue(&executableName, name); } /* -- cgit v0.12 From bd2dadab2d53cd341caf886ecd8541c5958f9546 Mon Sep 17 00:00:00 2001 From: griffin Date: Sat, 25 May 2024 18:32:05 +0000 Subject: Add note about static vs dynamic builds. --- doc/zipfs.n | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/doc/zipfs.n b/doc/zipfs.n index d4f97a8..60b98c5 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -203,6 +203,18 @@ then the resulting image is an executable that will \fBsource\fR the script in that \fBmain.tcl\fR after mounting the ZIP archive, and will \fBexit\fR once that script has been executed. .PP +\fBNote:\fR \fBtclsh\fR and \fBwish\fR can be built using either +dynamic binding or static binding of the core implemenation +libraries. With a dynamic binding, the base application Tcl_Library +contents are attached to the \fBlibtcl\fR and \fBlibtk\fR shared +library, respectively. With a static binding, the Tcl_Library +contents, etc., are attached to the application, \fBtclsh\fR or +\fBwish\fR. When using \fBmkimg\fR with a staticly built tclsh, it is +the user's responsibility to preserve the attached archive by first +extracting it to a temporary location, and then add whatever +additional files desired, before creating and attaching the new +archive to the new application. +.PP \fBCaution:\fR highly experimental, not usable on Android, only partially tested on Linux and Windows. .RE -- cgit v0.12 From ca2e6faeaae3e6a777b4d56cdf0bb2e09f449b0f Mon Sep 17 00:00:00 2001 From: griffin Date: Sun, 26 May 2024 19:21:49 +0000 Subject: Fix spelling errors. --- doc/zipfs.n | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/zipfs.n b/doc/zipfs.n index 60b98c5..9ac283d 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -57,7 +57,7 @@ This takes the name of a file, \fIfilename\fR, and produces where it would be mapped into a zipfs mount as its result. If specified, \fImountpoint\fR says within which mount the mapping will be done; if omitted, the main root of the zipfs system is used. The \fIinZipfs\fR argument is a an optional boolean -which controls whether to fully canonicalise the name; it defaults to true. +which controls whether to fully canonicalize the name; it defaults to true. .\" METHOD: exists .TP \fBzipfs exists\fI filename\fR @@ -204,12 +204,12 @@ that \fBmain.tcl\fR after mounting the ZIP archive, and will \fBexit\fR once that script has been executed. .PP \fBNote:\fR \fBtclsh\fR and \fBwish\fR can be built using either -dynamic binding or static binding of the core implemenation +dynamic binding or static binding of the core implementation libraries. With a dynamic binding, the base application Tcl_Library contents are attached to the \fBlibtcl\fR and \fBlibtk\fR shared library, respectively. With a static binding, the Tcl_Library contents, etc., are attached to the application, \fBtclsh\fR or -\fBwish\fR. When using \fBmkimg\fR with a staticly built tclsh, it is +\fBwish\fR. When using \fBmkimg\fR with a statically built tclsh, it is the user's responsibility to preserve the attached archive by first extracting it to a temporary location, and then add whatever additional files desired, before creating and attaching the new -- cgit v0.12 From db021e3e310e397f652d3597f5335868957ce8ca Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 27 May 2024 12:52:36 +0000 Subject: Missing ',' between "INDEX" and "OUTOFRANGE" --- generic/tclCmdIL.c | 9 +++------ generic/tclListObj.c | 9 +++------ generic/tclUtil.c | 6 ++---- 3 files changed, 8 insertions(+), 16 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 37c9822..83320cd 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2638,8 +2638,7 @@ Tcl_LpopObjCmd( /* empty list, throw the same error as with index "end" */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "index \"end\" out of range", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" - "OUTOFRANGE", (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL); return TCL_ERROR; } @@ -3497,8 +3496,7 @@ Tcl_LsearchObjCmd( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "index \"%s\" out of range", TclGetString(indices[j]))); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" - "OUTOFRANGE", (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL); result = TCL_ERROR; } if (result == TCL_ERROR) { @@ -4640,8 +4638,7 @@ Tcl_LsortObjCmd( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "index \"%s\" out of range", TclGetString(indexv[j]))); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" - "OUTOFRANGE", (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL); result = TCL_ERROR; } if (result == TCL_ERROR) { diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 1bb3587..a8e16d4 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -2970,10 +2970,8 @@ TclLsetFlat( /* ...the index points outside the sublist. */ if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "index \"%s\" out of range", - Tcl_GetString(indexArray[-1]))); - Tcl_SetErrorCode(interp, - "TCL", "VALUE", "INDEX" "OUTOFRANGE", (void *)NULL); + "index \"%s\" out of range", TclGetString(indexArray[-1]))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL); } result = TCL_ERROR; break; @@ -3163,8 +3161,7 @@ TclListObjSetElement( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "index \"%" TCL_SIZE_MODIFIER "d\" out of range", index)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", - "OUTOFRANGE", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL); } return TCL_ERROR; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index e2c96a9..c2fa64f 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3921,10 +3921,8 @@ TclIndexEncode( rangeerror: if (interp) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("index \"%s\" out of range", TclGetString(objPtr))); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (void *)NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("index \"%s\" out of range", TclGetString(objPtr))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (char *)NULL); } return TCL_ERROR; } -- cgit v0.12 From 0287c421a00eaa857c07d1f947d64a33550693e9 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Tue, 28 May 2024 11:32:39 +0000 Subject: Fix tests - need longer timer under valgrind. Close created channels. --- tests/io.test | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/tests/io.test b/tests/io.test index a41e56b..ad8d6b7 100644 --- a/tests/io.test +++ b/tests/io.test @@ -6331,7 +6331,8 @@ test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup { set x done } }] - set token [after 10000 [namespace code { + # Note: timeout needs to be very long under valgrind + set token [after 240000 [namespace code { set x timeout }]] vwait [namespace which -variable x] @@ -6357,12 +6358,12 @@ test io-44.7 {refchan + coroutine yield error } -setup { proc initialize {chan mode} { return [list initialize finalize read watch] } - - proc read {chan count} { - } - + proc finalize args {} + proc read {chan count} {} proc watch {chan eventspec} { - after idle after 0 chan postevent $chan $eventspec + foreach event $eventspec { + after idle after 0 chan postevent $chan $event + } } } } -cleanup { @@ -6377,6 +6378,7 @@ test io-44.7 {refchan + coroutine yield error } -setup { set chan [schan::open] chan event $chan readable [list [info coroutine]] yield + close $chan set ::io-44.7-result success } [namespace current]] vwait ::io-44.7-result -- cgit v0.12 From 743451a5f564b80d1b34b0f8b89f7e588b655bc1 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 28 May 2024 13:08:11 +0000 Subject: partial merge 8.7 (cherrypick of tests changes only) --- tests/cmdMZ.test | 15 +++++++++++---- tests/ioTrans.test | 2 -- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index da7ce5c..9af30bd 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -320,11 +320,15 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} { # todo: rewrite this if monotonic clock is provided resp. command "after" # gets microsecond accuracy (RFE [fdfbd5e10] gets merged): proc _nrt_sleep {msec} { - set usec [expr {$msec * 1000}] set stime [clock microseconds] - while {abs([clock microseconds] - $stime) < $usec} { - # don't use after 0 unless it's NRT-capable, so yes - busy-wait (but it's more precise): - # after 0 + set usec [expr {$msec * 1000}] + set etime [expr {$stime + $usec}] + while {[set tm [clock microseconds]] < $etime} { + # don't use after 0 unless it's NRT-capable, so yes - busy-wait (but it's more precise): + # after 0 + if {$tm < $stime} { # avoid too long delays by backwards time jumps, simply skip test + tcltest::Skip "time-jump?" + } } } _nrt_sleep 0; # warm up (clock, compile, etc) @@ -404,6 +408,9 @@ test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measurement} -body { set m1 [timerate {_nrt_sleep 0.01} 50] set m2 [timerate {_nrt_sleep 1.00} 50] + if {[testConstraint valgrind] && ([lindex $m1 0] >= 100 || [lindex $m1 2] <= 500)} { + tcltest::Skip "too-slow-by-valgrind" + } list [list \ [expr {[lindex $m1 0] < [lindex $m2 0]}] \ [expr {[lindex $m1 0] < 100}] \ diff --git a/tests/ioTrans.test b/tests/ioTrans.test index 45d2530..265520a 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -2096,8 +2096,6 @@ test iortrans.tf-11.0 {origin thread of moved transform gone} -setup { thread::release $tidb } -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}} -testConstraint notValgrind [expr {![testConstraint valgrind]}] - test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} -setup { #puts <<$tcltest::mainThread>>main set tida [thread::create -preserved]; #puts <<$tida>> -- cgit v0.12