diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2002-02-15 14:28:47 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2002-02-15 14:28:47 (GMT) |
| commit | 66a15c6f8be47c3acbdddffadc67f50dec8a56e6 (patch) | |
| tree | edaf81ee6d40edeacc9f3e2093ddcb2ba302c620 | |
| parent | 2827a2692798a7a0ec46e684a4ccc83afb39859e (diff) | |
| download | tcl-66a15c6f8be47c3acbdddffadc67f50dec8a56e6.zip tcl-66a15c6f8be47c3acbdddffadc67f50dec8a56e6.tar.gz tcl-66a15c6f8be47c3acbdddffadc67f50dec8a56e6.tar.bz2 | |
TIP#72 implementation. See ChangeLog for details.
This version builds clean on Solaris/SPARC, with GCC and CC, both with and
without threads and both in 32-bit and 64-bit mode.
76 files changed, 5280 insertions, 2167 deletions
@@ -1,3 +1,71 @@ +2002-02-15 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + +----------------------+ + | TIP #72 IMPLEMENTED. | + +----------------------+ + + There are a lot of changes from this TIP, so please see + http://purl.org/tcl/tip/72.html for discussion of + backward-compatability issues, but the main ones modifications are + in: + + * generic/tcl.h: New types. + * generic/tcl.decls: New public functions. + * generic/tclExecute.c: 64-bit aware bytecode engine. + * generic/tclBinary.c: 64-bit handling in [binary] command. + * generic/tclScan.c: 64-bit handling in [scan] command. + * generic/tclCmdAH.c: 64-bit handling in [file] and [format] + commands. + * generic/tclBasic.c: New "wordSize" entry in ::tcl_platform. + * generic/tclFCmd.c: Large-file support (with many consequences.) + * generic/tclIO.c: Large-file support (with many consequences.) + * compat/strtoll.c, compat/strtoull.c: New support functions. + * unix/tcl.m4, unix/configure: 64-bit support and greatly enhanced + cacheing. + + Most other changes, including all those in doc/* and test/* as + well as the majority in the platform directories, follow on from + these. + + Also coming out of the woodwork: + * generic/tclIndex.c: Better support for Cray PVP. + * win/tclWinMtherr.c: Better Borland support. + + Note that, in a number of places through the Unix part of the + platform support, there are Tcl_Platform* references. These are + expanded into the correct way to call that particular underlying + function, i.e. with or without a '64' suffix, and should be used + by people working on the core in preference to the API functions + they overlay so that the code remains portable depending on the + presence or absence of 64-bit support on the underlying platform. + + ***POTENTIAL INCOMPATIBILITY***: Extracted from the TIP + + SUMMARY OF INCOMPATIBILITIES AND FIXES + ====================================== + + The behaviour of expressions containing constants that appear + positive but which have a negative internal representation will + change, as these will now usually be interpreted as wide + integers. This is always fixable by replacing the constant with + int(constant). + + Extensions creating new channel types will need to be altered as + different types are now in use in those areas. The change to the + declaration of Tcl_FSStat and Tcl_FSLstat (which are the new + preferred API in any case) are less serious as no non-alpha + releases have been made yet with those API functions. + + Scripts that are lax about the use of the l modifier in format and + scan will probably need to be rewritten. This should be very + uncommon though as previously it had absolutely no effect. + + Extensions that create new math functions that take more than one + argument will need to be recompiled (the size of Tcl_Value + changes), and functions that accept arguments of any type + (TCL_EITHER) will need to be rewritten to handle wide integer + values. (I do not expect this to affect many extensions at all.) + 2002-02-14 Andreas Kupries <andreas_kupries@users.sourceforge.net> * generic/tclIOCmd.c (Tcl_GetsObjCmd): Trivial fix for bug diff --git a/compat/strtoll.c b/compat/strtoll.c new file mode 100644 index 0000000..2872006 --- /dev/null +++ b/compat/strtoll.c @@ -0,0 +1,106 @@ +/* + * strtoll.c -- + * + * Source code for the "strtoll" library procedure. + * + * Copyright (c) 1988 The Regents of the University of California. + * Copyright (c) 1994 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: strtoll.c,v 1.2 2002/02/15 14:28:47 dkf Exp $ + */ + +#include "tcl.h" +#include "tclPort.h" +#include <ctype.h> + +#define TCL_WIDEINT_MAX (((Tcl_WideUInt)Tcl_LongAsWide(-1))>>1) + + +/* + *---------------------------------------------------------------------- + * + * strtol -- + * + * Convert an ASCII string into an integer. + * + * Results: + * The return value is the integer equivalent of string. If endPtr + * is non-NULL, then *endPtr is filled in with the character + * after the last one that was part of the integer. If string + * doesn't contain a valid integer value, then zero is returned + * and *endPtr is set to string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_WideInt +strtoll(string, endPtr, base) + char *string; /* String of ASCII digits, possibly + * preceded by white space. For bases + * greater than 10, either lower- or + * upper-case digits may be used. + */ + char **endPtr; /* Where to store address of terminating + * character, or NULL. */ + int base; /* Base for conversion. Must be less + * than 37. If 0, then the base is chosen + * from the leading characters of string: + * "0x" means hex, "0" means octal, anything + * else means decimal. + */ +{ + register char *p; + Tcl_WideInt result; + Tcl_WideUInt uwResult; + + /* + * Skip any leading blanks. + */ + + p = string; + while (isspace(*p)) { + p += 1; + } + + /* + * Check for a sign. + */ + + if (*p == '-') { + p += 1; + uwResult = strtoull(p, endPtr, base); + if (errno != ERANGE) { + if (uwResult > TCL_WIDEINT_MAX+1) { + errno = ERANGE; + return Tcl_LongAsWide(-1); + } else if (uwResult > TCL_WIDEINT_MAX) { + return ~((Tcl_WideInt)TCL_WIDEINT_MAX); + } else { + result = -uwResult; + } + } + } else { + if (*p == '+') { + p += 1; + } + uwResult = strtoull(p, endPtr, base); + if (errno != ERANGE) { + if (uwResult > TCL_WIDEINT_MAX) { + errno = ERANGE; + return Tcl_LongAsWide(-1); + } else { + result = uwResult; + } + } + } + if ((result == 0) && (endPtr != 0) && (*endPtr == p)) { + *endPtr = string; + } + return result; +} diff --git a/compat/strtoull.c b/compat/strtoull.c new file mode 100644 index 0000000..8658eb0 --- /dev/null +++ b/compat/strtoull.c @@ -0,0 +1,245 @@ +/* + * strtoull.c -- + * + * Source code for the "strtoull" library procedure. + * + * Copyright (c) 1988 The Regents of the University of California. + * Copyright (c) 1994 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: strtoull.c,v 1.2 2002/02/15 14:28:47 dkf Exp $ + */ + +#include "tcl.h" +#include "tclPort.h" +#include <ctype.h> + +/* + * The table below is used to convert from ASCII digits to a + * numerical equivalent. It maps from '0' through 'z' to integers + * (100 for non-digit characters). + */ + +static char cvtIn[] = { + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, /* '0' - '9' */ + 100, 100, 100, 100, 100, 100, 100, /* punctuation */ + 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'A' - 'Z' */ + 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, + 30, 31, 32, 33, 34, 35, + 100, 100, 100, 100, 100, 100, /* punctuation */ + 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'a' - 'z' */ + 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, + 30, 31, 32, 33, 34, 35}; + + +/* + *---------------------------------------------------------------------- + * + * strtoull -- + * + * Convert an ASCII string into an integer. + * + * Results: + * The return value is the integer equivalent of string. If endPtr + * is non-NULL, then *endPtr is filled in with the character + * after the last one that was part of the integer. If string + * doesn't contain a valid integer value, then zero is returned + * and *endPtr is set to string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_WideUInt +strtoull(string, endPtr, base) + char *string; /* String of ASCII digits, possibly + * preceded by white space. For bases + * greater than 10, either lower- or + * upper-case digits may be used. + */ + char **endPtr; /* Where to store address of terminating + * character, or NULL. */ + int base; /* Base for conversion. Must be less + * than 37. If 0, then the base is chosen + * from the leading characters of string: + * "0x" means hex, "0" means octal, anything + * else means decimal. + */ +{ + register char *p; + register Tcl_WideUInt result = 0; + register unsigned digit; + register Tcl_WideUInt shifted; + int anyDigits = 0, negative = 0; + + /* + * Skip any leading blanks. + */ + + p = string; + while (isspace(*p)) { /* INTL: locale-dependent */ + p += 1; + } + + /* + * Check for a sign. + */ + + if (*p == '-') { + p += 1; + negative = 1; + } else { + if (*p == '+') { + p += 1; + } + } + + /* + * If no base was provided, pick one from the leading characters + * of the string. + */ + + if (base == 0) { + if (*p == '0') { + p += 1; + if (*p == 'x' || *p == 'X') { + p += 1; + base = 16; + } else { + + /* + * Must set anyDigits here, otherwise "0" produces a + * "no digits" error. + */ + + anyDigits = 1; + base = 8; + } + } else { + base = 10; + } + } else if (base == 16) { + + /* + * Skip a leading "0x" from hex numbers. + */ + + if ((p[0] == '0') && (p[1] == 'x' || *p == 'X')) { + p += 2; + } + } + + /* + * Sorry this code is so messy, but speed seems important. Do + * different things for base 8, 10, 16, and other. + */ + + if (base == 8) { + for ( ; ; p += 1) { + digit = *p - '0'; + if (digit > 7) { + break; + } + shifted = result << 3; + if ((shifted >> 3) != result) { + goto overflow; + } + result = shifted + digit; + anyDigits = 1; + } + } else if (base == 10) { + for ( ; ; p += 1) { + digit = *p - '0'; + if (digit > 9) { + break; + } + shifted = 10 * result; + if ((shifted / 10) != result) { + goto overflow; + } + result = shifted + digit; + anyDigits = 1; + } + } else if (base == 16) { + for ( ; ; p += 1) { + digit = *p - '0'; + if (digit > ('z' - '0')) { + break; + } + digit = cvtIn[digit]; + if (digit > 15) { + break; + } + shifted = result << 4; + if ((shifted >> 4) != result) { + goto overflow; + } + result = shifted + digit; + anyDigits = 1; + } + } else { + for ( ; ; p += 1) { + digit = *p - '0'; + if (digit > ('z' - '0')) { + break; + } + digit = cvtIn[digit]; + if (digit >= base) { + break; + } + shifted = result * base; + if ((shifted/base) != result) { + goto overflow; + } + result = shifted + digit; + anyDigits = 1; + } + } + + /* + * Negate if we found a '-' earlier. + */ + + if (negative) { + result = (Tcl_WideUInt)(-((Tcl_WideInt)result)); + } + + /* + * See if there were any digits at all. + */ + + if (!anyDigits) { + p = string; + } + + if (endPtr != 0) { + *endPtr = p; + } + + return result; + + /* + * On overflow generate the right output + */ + + overflow: + errno = ERANGE; + if (endPtr != 0) { + for ( ; ; p += 1) { + digit = *p - '0'; + if (digit > ('z' - '0')) { + break; + } + digit = cvtIn[digit]; + if (digit >= base) { + break; + } + } + *endPtr = p; + } + return (Tcl_WideUInt)Tcl_LongAsWide(-1); +} diff --git a/doc/Access.3 b/doc/Access.3 index c603a1c..6830694 100644 --- a/doc/Access.3 +++ b/doc/Access.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Access.3,v 1.6 2002/01/29 02:28:20 hobbs Exp $ +'\" RCS: @(#) $Id: Access.3,v 1.7 2002/02/15 14:28:47 dkf Exp $ '\" .so man.macros .TH Tcl_Access 3 8.1 Tcl "Tcl Library Procedures" @@ -21,7 +21,7 @@ int int \fBTcl_Stat\fR(\fIpath\fR, \fIstatPtr\fR) .SH ARGUMENTS -.AS stat *statPtr in +.AS "struct stat" *statPtr in .AP char *path in Native name of the file to check the attributes of. .AP int mode in @@ -29,7 +29,7 @@ Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK. R_OK, W_OK and X_OK request checking whether the file exists and has read, write and execute permissions, respectively. F_OK just requests checking for the existence of the file. -.AP stat *statPtr out +.AP "struct stat" *statPtr out The structure that contains the result. .BE @@ -73,3 +73,4 @@ given. .SH KEYWORDS stat, access + diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index 21ef533..cbfa25b 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -4,13 +4,13 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: FileSystem.3,v 1.18 2002/01/30 17:33:48 vincentdarley Exp $ +'\" RCS: @(#) $Id: FileSystem.3,v 1.19 2002/02/15 14:28:47 dkf Exp $ '\" .so man.macros .TH Filesystem 3 8.4 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSLoadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo \- procedures to interact with any filesystem +Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSLoadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_AllocStatBuf \- procedures to interact with any filesystem .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -134,6 +134,9 @@ CONST char* .sp Tcl_Obj* \fBTcl_FSFileSystemInfo\fR(\fIpathPtr\fR) +.sp +Tcl_StatBuf* +\fBTcl_AllocStatBuf\fR() .SH ARGUMENTS .AS Tcl_Filesystem *fsPtr in .AP Tcl_Filesystem *fsPtr in @@ -187,7 +190,7 @@ Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK. R_OK, W_OK and X_OK request checking whether the file exists and has read, write and execute permissions, respectively. F_OK just requests checking for the existence of the file. -.AP stat *statPtr out +.AP Tcl_StatBuf *statPtr out The structure that contains the result of a stat or lstat operation. .AP "CONST char" *sym1 in Name of a procedure to look up in the file's symbol table @@ -243,6 +246,10 @@ registered, the 'files' may, to give two examples, be remote (e.g. situated on a remote ftp server) or archived (e.g. lying inside a .zip archive). Such registered filesystems provide a lookup table of functions to implement all or some of the functionality listed here. +Finally, the \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR calls abstract +away from what the 'struct stat' buffer buffer is actually declared to +be, allowing the same code to be used both on systems with and systems +without support for files larger than 2GB in size. .PP The \fBTcl_FS...\fR are objectified and may cache internal representations and other path-related strings (e.g. the current @@ -565,6 +572,12 @@ absolute. It returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or TCL_PATH_VOLUME_RELATIVE .PP +\fBTcl_AllocStatBuf\fR allocates a \fITcl_StatBuf\fR on the system +heap (which may be deallocated by being passed to \fBckfree\fR.) This +allows extensions to invoke \fBTcl_FSStat\fR and \fBTcl_FSLStat\fR +without being dependent on the size of the buffer. That in turn +depends on the flags used to build Tcl. +.PP .SH TCL_FILESYSTEM .PP A filesystem provides a \fBTcl_Filesystem\fR structure that contains @@ -809,7 +822,7 @@ upon it (e.g. \fBfile atime\fR, \fBfile isdirectory\fR, \fBfile size\fR, .CS typedef int Tcl_FSStatProc( Tcl_Obj *\fIpathPtr\fR, - struct stat *\fIstatPtr\fR); + Tcl_StatBuf *\fIstatPtr\fR); .CE .PP The \fBTcl_FSStatProc\fR fills the stat structure \fIstatPtr\fR with @@ -1082,7 +1095,7 @@ it need only be implemented if a filesystem can differentiate between .CS typedef int Tcl_FSLstatProc( Tcl_Obj *\fIpathPtr\fR, - struct stat *\fIstatPtr\fR); + Tcl_StatBuf *\fIstatPtr\fR); .CE .PP The behavior of this function is very similar to that of the @@ -1225,5 +1238,3 @@ directory to the value specified in \fIpathPtr\fR. The function returns -1 on error or 0 on success. .SH KEYWORDS stat access filesystem vfs - - diff --git a/doc/GetIndex.3 b/doc/GetIndex.3 index 06b5ed7..79d3a1e 100644 --- a/doc/GetIndex.3 +++ b/doc/GetIndex.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: GetIndex.3,v 1.8 2002/01/17 04:37:32 dgp Exp $ +'\" RCS: @(#) $Id: GetIndex.3,v 1.9 2002/02/15 14:28:47 dkf Exp $ '\" .so man.macros .TH Tcl_GetIndexFromObj 3 8.1 Tcl "Tcl Library Procedures" @@ -34,7 +34,7 @@ The string value of this object is used to search through \fItablePtr\fR. The internal representation is modified to hold the index of the matching table entry. .AP "CONST char" **tablePtr in -An array of null-terminated strings. The end of the array is marked +An array of null-terminated ASCII strings. The end of the array is marked by a NULL string pointer. .VS .AP int offset in diff --git a/doc/IntObj.3 b/doc/IntObj.3 index 6222498..1dc5b0e 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -4,13 +4,13 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: IntObj.3,v 1.2 1998/09/14 18:39:49 stanton Exp $ +'\" RCS: @(#) $Id: IntObj.3,v 1.3 2002/02/15 14:28:47 dkf Exp $ '\" .so man.macros .TH Tcl_IntObj 3 8.0 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_NewIntObj, Tcl_NewLongObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_GetIntFromObj, Tcl_GetLongFromObj \- manipulate Tcl objects as integers +Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj \- manipulate Tcl objects as integers and wide integers .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -21,29 +21,51 @@ Tcl_Obj * Tcl_Obj * \fBTcl_NewLongObj\fR(\fIlongValue\fR) .sp +.VS 8.4 +Tcl_Obj * +\fBTcl_NewWideIntObj\fR(\fIwideValue\fR) +.VE 8.4 +.sp \fBTcl_SetIntObj\fR(\fIobjPtr, intValue\fR) .sp \fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR) .sp +.VS 8.4 +\fBTcl_SetWideIntObj\fR(\fIobjPtr, wideValue\fR) +.VE 8.4 +.sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) .sp int \fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR) +.sp +.VS 8.4 +int +\fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR) +.VE 8.4 .SH ARGUMENTS -.AS Tcl_Interp *interp +.AS Tcl_WideInt *interp .AP int intValue in Integer value used to initialize or set an integer object. .AP long longValue in Long integer value used to initialize or set an integer object. +.AP Tcl_WideInt wideValue in +.VS 8.4 +Wide integer value (minimum 64-bits wide where supported by the +compiler) used to initialize or set a wide integer object. +.VE 8.4 .AP Tcl_Obj *objPtr in/out -For \fBTcl_SetIntObj\fR and \fBTcl_SetLongObj\fR, -this points to the object to be converted to integer type. -For \fBTcl_GetIntFromObj\fR and \fBTcl_GetLongFromObj\fR, -this refers to the object -from which to get an integer or long integer value; -if \fIobjPtr\fR does not already point to an integer object, -an attempt will be made to convert it to one. +For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, and +.VS 8.4 +\fBTcl_SetWideIntObj\fR, this points to the object to be converted to +integer type. For \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, +and \fBTcl_GetWideIntFromObj\fR, this refers to the object from which +to get an integer or long integer value; if \fIobjPtr\fR does not +already point to an integer object (or a wide integer object in the +case of \fBTcl_SetWideIntObj\fR and \fBTcl_GetWideIntFromObj\fR,) an +.VE 8.4 +attempt will be made to convert it to one. .AP Tcl_Interp *interp in/out If an error occurs during conversion, an error message is left in the interpreter's result object @@ -54,34 +76,54 @@ obtained by \fBTcl_GetIntFromObj\fR from \fIobjPtr\fR. .AP long *longPtr out Points to place to store the long integer value obtained by \fBTcl_GetLongFromObj\fR from \fIobjPtr\fR. +.AP Tcl_WideInt *widePtr out +.VS 8.4 +Points to place to store the wide integer value +obtained by \fBTcl_GetWideIntFromObj\fR from \fIobjPtr\fR. +.VE 8.4 .BE .SH DESCRIPTION .PP These procedures are used to create, modify, and read -integer Tcl objects from C code. +integer and wide integer Tcl objects from C code. \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_SetIntObj\fR, and \fBTcl_SetLongObj\fR create a new object of integer type -or modify an existing object to have integer type. +or modify an existing object to have integer type, +.VS 8.4 +and \fBTcl_NewWideIntObj\fR and \fBTcl_SetWideIntObj\fR create a new +object of wide integer type or modify an existing object to have wide +integer type. +.VE 8.4 \fBTcl_NewIntObj\fR and \fBTcl_SetIntObj\fR set the object to have the integer value given by \fIintValue\fR, -while \fBTcl_NewLongObj\fR and \fBTcl_SetLongObj\fR +\fBTcl_NewLongObj\fR and \fBTcl_SetLongObj\fR set the object to have the -long integer value given by \fIlongValue\fR. -\fBTcl_NewIntObj\fR and \fBTcl_NewLongObj\fR +long integer value given by \fIlongValue\fR, +.VS 8.4 +and \fBTcl_NewWideIntObj\fR and \fBTcl_SetWideIntObj\fR set the object +to have the wide integer value given by \fIwideValue\fR. +\fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR and \fBTcl_NewWideIntObj\fR return a pointer to a newly created object with reference count zero. These procedures set the object's type to be integer and assign the integer value to the object's internal representation -\fIlongValue\fR member. -\fBTcl_SetIntObj\fR and \fBTcl_SetLongObj\fR +\fIlongValue\fR or \fIwideValue\fR member (as appropriate). +\fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR +and \fBTcl_SetWideIntObj\fR +.VE 8.4 invalidate any old string representation and, if the object is not already an integer object, free any old internal representation. .PP \fBTcl_GetIntFromObj\fR and \fBTcl_GetLongFromObj\fR -attempt to return an integer value from the Tcl object \fIobjPtr\fR. +attempt to return an integer value from the Tcl object \fIobjPtr\fR, +.VS 8.4 +and \fBTcl_GetWideIntFromObj\fR attempts to return a wide integer +value from the Tcl object \fIobjPtr\fR. If the object is not already an integer object, +or a wide integer object in the case of \fBTcl_GetWideIntFromObj\fR +.VE 8.4 they will attempt to convert it to one. If an error occurs during conversion, they return \fBTCL_ERROR\fR and leave an error message in the interpreter's result object @@ -91,11 +133,14 @@ Also, if the long integer held in the object's internal representation \fBTcl_GetIntFromObj\fR returns \fBTCL_ERROR\fR and leaves an error message in the interpreter's result object unless \fIinterp\fR is NULL. -Otherwise, both procedures return \fBTCL_OK\fR and -store the integer or the long integer value -in the address given by \fIintPtr\fR and \fIlongPtr\fR respectively. -If the object is not already an integer object, -the conversion will free any old internal representation. +Otherwise, all three procedures return \fBTCL_OK\fR and +store the integer, long integer value +.VS 8.4 +or wide integer in the address given by \fIintPtr\fR, \fIlongPtr\fR +and \fIwidePtr\fR +.VE 8.4 +respectively. If the object is not already an integer or wide integer +object, the conversion will free any old internal representation. .SH "SEE ALSO" Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult diff --git a/doc/LinkVar.3 b/doc/LinkVar.3 index 0a4a58f..48d4f9e 100644 --- a/doc/LinkVar.3 +++ b/doc/LinkVar.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: LinkVar.3,v 1.3 2000/04/14 23:01:51 hobbs Exp $ +'\" RCS: @(#) $Id: LinkVar.3,v 1.4 2002/02/15 14:28:47 dkf Exp $ '\" .so man.macros .TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures" @@ -34,6 +34,9 @@ temporary modifications to it while parsing the variable name. Address of C variable that is to be linked to \fIvarName\fR. .AP int type in Type of C variable. Must be one of TCL_LINK_INT, TCL_LINK_DOUBLE, +.VS 8.4 +TCL_LINK_WIDE_INT, +.VE 8.4 TCL_LINK_BOOLEAN, or TCL_LINK_STRING, optionally OR'ed with TCL_LINK_READ_ONLY to make Tcl variable read-only. .BE @@ -58,17 +61,27 @@ TCL_LINK_READ_ONLY: \fBTCL_LINK_INT\fR The C variable is of type \fBint\fR. Any value written into the Tcl variable must have a proper integer -form acceptable to \fBTcl_GetInt\fR; attempts to write +form acceptable to \fBTcl_GetIntFromObj\fR; attempts to write non-integer values into \fIvarName\fR will be rejected with Tcl errors. .TP \fBTCL_LINK_DOUBLE\fR The C variable is of type \fBdouble\fR. Any value written into the Tcl variable must have a proper real -form acceptable to \fBTcl_GetDouble\fR; attempts to write +form acceptable to \fBTcl_GetDoubleFromObj\fR; attempts to write non-real values into \fIvarName\fR will be rejected with Tcl errors. .TP +\fBTCL_LINK_WIDE_INT\fR +.VS 8.4 +The C variable is of type \fBTcl_WideInt\fR (which is an integer type +at least 64-bits wide on all platforms that can support it.) +Any value written into the Tcl variable must have a proper integer +form acceptable to \fBTcl_GetWideIntFromObj\fR; attempts to write +non-integer values into \fIvarName\fR will be rejected with +Tcl errors. +.VE 8.4 +.TP \fBTCL_LINK_BOOLEAN\fR The C variable is of type \fBint\fR. If its value is zero then it will read from Tcl as ``0''; @@ -76,7 +89,7 @@ otherwise it will read from Tcl as ``1''. Whenever \fIvarName\fR is modified, the C variable will be set to a 0 or 1 value. Any value written into the Tcl variable must have a proper boolean -form acceptable to \fBTcl_GetBoolean\fR; attempts to write +form acceptable to \fBTcl_GetBooleanFromObj\fR; attempts to write non-boolean values into \fIvarName\fR will be rejected with Tcl errors. .TP diff --git a/doc/binary.n b/doc/binary.n index 0369457..19fed15 100644 --- a/doc/binary.n +++ b/doc/binary.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: binary.n,v 1.7 2001/10/04 08:31:52 dkf Exp $ +'\" RCS: @(#) $Id: binary.n,v 1.8 2002/02/15 14:28:47 dkf Exp $ '\" .so man.macros .TH binary n 8.0 Tcl "Tcl Built-In Commands" @@ -199,6 +199,30 @@ For example, will return a string equivalent to \fB\\x00\\x00\\x00\\x03\\xff\\xff\\xff\\xfd\\x00\\x01\\x00\\x00\fR .RE +.IP \fBw\fR 5 +.VS 8.4 +This form is the same as \fBw\fR except that it stores one or more +64-bit integers in little-endian byte order in the output string. The +low-order 64-bits of each integer are stored as an eight-byte value at +the cursor position with the least significant byte stored first. For +example, +.RS +.CS +\fBbinary format w 7810179016327718216\fR +.CE +will return the string \fBHelloTcl\fR +.RE +.IP \fBW\fR 5 +This form is the same as \fBw\fR except that it stores one or more one +or more 64-bit integers in big-endian byte order in the output string. +For example, +.RS +.CS +\fBbinary format W 4785469626960341345\fR +.CE +will return the string \fBBigEndian\fR +.VE +.RE .IP \fBf\fR 5 This form is the same as \fBc\fR except that it stores one or more one or more single-precision floating in the machine's native @@ -463,6 +487,34 @@ order. For example, will return \fB2\fR with \fB5 7\fR stored in \fBvar1\fR and \fB-16\fR stored in \fBvar2\fR. .RE +.IP \fBw\fR 5 +.VS 8.4 +The data is interpreted as \fIcount\fR 64-bit signed integers +represented in little-endian byte order. The integers are stored in +the corresponding variable as a list. If \fIcount\fR is \fB*\fR, then +all of the remaining bytes in \fBstring\fR will be scanned. If +\fIcount\fR is omitted, then one 64-bit integer will be scanned. For +example, +.RS +.CS +\fBbinary scan \\x05\\x00\\x00\\x00\\x07\\x00\\x00\\x00\\xf0\\xff\\xff\\xff wi* var1 var2\fR +.CE +will return \fB2\fR with \fB30064771077\fR stored in \fBvar1\fR and +\fB-16\fR stored in \fBvar2\fR. Note that the integers returned are +signed and cannot be represented by Tcl as unsigned values. +.RE +.IP \fBW\fR 5 +This form is the same as \fBw\fR except that the data is interpreted +as \fIcount\fR 64-bit signed integers represented in big-endian byte +order. For example, +.RS +.CS +\fBbinary scan \\x00\\x00\\x00\\x05\\x00\\x00\\x00\\x07\\xff\\xff\\xff\\xf0 WI* var1 var2\fR +.CE +will return \fB2\fR with \fB21474836487\fR stored in \fBvar1\fR and \fB-16\fR +stored in \fBvar2\fR. +.VE +.RE .IP \fBf\fR 5 The data is interpreted as \fIcount\fR single-precision floating point numbers in the machine's native representation. The floating point @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: expr.n,v 1.6 2001/12/03 10:42:47 dkf Exp $ +'\" RCS: @(#) $Id: expr.n,v 1.7 2002/02/15 14:28:47 dkf Exp $ '\" .so man.macros .TH expr n 8.4 Tcl "Tcl Built-In Commands" @@ -55,6 +55,13 @@ If no numeric interpretation is possible, then an operand is left as a string (and only a limited set of operators may be applied to it). .PP +.VS 8.4 +On 32-bit systems, integer values MAX_INT (0x7FFFFFFF) and MIN_INT +(-0x80000000) will be represented as 32-bit values, and integer values +outside that range will be represented as 64-bit values (if that is +possible at all.) +.VE 8.4 +.PP Operands may be specified in any of the following ways: .IP [1] As an numeric value, either integer or floating-point. @@ -251,8 +258,12 @@ Computes the length of the hypotenuse of a right-angled triangle \fBsqrt(\fIx\fR*\fIx\fR+\fIy\fR*\fIy\fB)\fR. .TP \fBint(\fIarg\fB)\fR -If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise converts -\fIarg\fR to integer by truncation and returns the converted value. +.VS 8.4 +If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise +converts \fIarg\fR to an integer (of the same size as a machine word, +i.e. 32-bits on 32-bit systems, and 64-bits on 64-bit systems) by +truncation and returns the converted value. +.VE 8.4 .TP \fBlog(\fIarg\fB)\fR Returns the natural logarithm of \fIarg\fR. \fIArg\fR must be a @@ -296,6 +307,12 @@ Returns the tangent of \fIarg\fR, measured in radians. .TP \fBtanh(\fIarg\fB)\fR Returns the hyperbolic tangent of \fIarg\fR. +.TP +\fBwide(\fIarg\fB)\fR +.VS 8.4 +Converts \fIarg\fR to a value at least 64-bits wide (by sign-extension +if \fIarg\fR is a 32-bit number.) +.VE 8.4 .PP In addition to these predefined functions, applications may define additional functions using \fBTcl_CreateMathFunc\fR(). diff --git a/doc/format.n b/doc/format.n index 736840e..db72688 100644 --- a/doc/format.n +++ b/doc/format.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: format.n,v 1.5 2000/09/07 14:27:48 poenitz Exp $ +'\" RCS: @(#) $Id: format.n,v 1.6 2002/02/15 14:28:47 dkf Exp $ '\" .so man.macros .TH format n 8.1 Tcl "Tcl Built-In Commands" @@ -131,7 +131,10 @@ which must be \fBh\fR or \fBl\fR. If it is \fBh\fR it specifies that the numeric value should be truncated to a 16-bit value before converting. This option is rarely useful. -The \fBl\fR modifier is ignored. +.VS 8.4 +If it is \fBl\fR it specifies that the numeric value should be (at +least) a 64-bit value. +.VE .PP The last thing in a conversion specifier is an alphabetic character that determines what kind of conversion to perform. @@ -6,10 +6,10 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: scan.n,v 1.7 2000/12/10 03:27:03 hobbs Exp $ +'\" RCS: @(#) $Id: scan.n,v 1.8 2002/02/15 14:28:48 dkf Exp $ '\" .so man.macros -.TH scan n 8.3 Tcl "Tcl Built-In Commands" +.TH scan n 8.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -28,13 +28,11 @@ to be parsed and \fIformat\fR indicates how to parse it, using \fB%\fR conversion specifiers as in \fBsscanf\fR. Each \fIvarName\fR gives the name of a variable; when a field is scanned from \fIstring\fR the result is converted back into a string and assigned to the corresponding variable. -.VS 8.3 If no \fIvarName\fR variables are specified, then \fBscan\fR works in an inline manner, returning the data that would otherwise be stored in the variables as a list. In the inline case, an empty string is returned when the end of the input string is reached before any conversions have been performed. -.VE 8.3 .SH "DETAILS ON SCANNING" .PP @@ -46,10 +44,13 @@ Otherwise, if it isn't a \fB%\fR character then it must match the next character of \fIstring\fR. When a \fB%\fR is encountered in \fIformat\fR, it indicates the start of a conversion specifier. +.VS 8.4 A conversion specifier contains up to four fields after the \fB%\fR: a \fB*\fR, which indicates that the converted value is to be discarded instead of assigned to a variable; a XPG3 position specifier; a number -indicating a maximum field width; and a conversion character. +indicating a maximum field width; a field size modifier; and a +conversion character. +.VE 8.4 All of these fields are optional except for the conversion character. The fields that are present must appear in the order given above. .PP @@ -75,33 +76,56 @@ The following conversion characters are supported: \fBd\fR The input field must be a decimal integer. It is read in and the value is stored in the variable as a decimal string. +.VS 8.4 +If the \fBl\fR or \fBL\fR field size modifier is given, the scanned +value will have an internal representation that is at least 64-bits in +size. +.VE 8.4 .TP 10 \fBo\fR The input field must be an octal integer. It is read in and the value is stored in the variable as a decimal string. .VS 8.4 +If the \fBl\fR or \fBL\fR field size modifier is given, the scanned +value will have an internal representation that is at least 64-bits in +size. If the value exceeds MAX_INT (017777777777 on platforms using 32-bit -integers), it will be truncated to a signed integer. Hence, 037777777777 -will appear as -1 on a 32-bit machine. +integers when the \fBl\fR and \fBL\fR modifiers are not given), it +will be truncated to a signed integer. Hence, 037777777777 will +appear as -1 on a 32-bit machine by default. .VE 8.4 .TP 10 \fBx\fR The input field must be a hexadecimal integer. It is read in and the value is stored in the variable as a decimal string. .VS 8.4 +If the \fBl\fR or \fBL\fR field size modifier is given, the scanned +value will have an internal representation that is at least 64-bits in +size. If the value exceeds MAX_INT (0x7FFFFFFF on platforms using 32-bit -integers), it will be truncated to a signed integer. Hence, 0xFFFFFFFF -will appear as -1 on a 32-bit machine. +integers when the \fBl\fR and \fBL\fR modifiers are not given), it +will be truncated to a signed integer. Hence, 0xFFFFFFFF will appear +as -1 on a 32-bit machine. .VE 8.4 .TP 10 \fBu\fR The input field must be a decimal integer. The value is stored in the variable as an unsigned decimal integer string. +.VS 8.4 +If the \fBl\fR or \fBL\fR field size modifier is given, the scanned +value will have an internal representation that is at least 64-bits in +size. +.VE 8.4 .TP 10 \fBi\fR The input field must be an integer. The base (i.e. decimal, octal, or hexadecimal) is determined in the same fashion as described in \fBexpr\fR. The value is stored in the variable as a decimal string. +.VS 8.4 +If the \fBl\fR or \fBL\fR field size modifier is given, the scanned +value will have an internal representation that is at least 64-bits in +size. +.VE 8.4 .TP 10 \fBc\fR A single character is read in and its binary value is stored in @@ -177,16 +201,14 @@ converted to a decimal string, which is then assigned to the corresponding \fIvarName\fR; no field width may be specified for this conversion. .IP [3] -The \fBl\fR, \fBh\fR, and \fBL\fR modifiers are ignored; integer -values are always converted as if there were no modifier present -and real values are always converted as if the \fBl\fR modifier -were present (i.e. type \fBdouble\fR is used for the internal -representation). +.VS 8.4 +The \fBh\fR modifier is always ignored and the \fBl\fR and \fBL\fR +modifiers are ignored when converting real values (i.e. type +\fBdouble\fR is used for the internal representation). +.VE 8.4 .IP [4] -.VS 8.3 If the end of the input string is reached before any conversions have been -performed and no variables are given, and empty string is returned. -.VE 8.3 +performed and no variables are given, an empty string is returned. .SH "SEE ALSO" format(n), sscanf(3) diff --git a/doc/tclvars.n b/doc/tclvars.n index 7c88903..4503add 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: tclvars.n,v 1.10 2001/11/23 01:29:19 das Exp $ +'\" RCS: @(#) $Id: tclvars.n,v 1.11 2002/02/15 14:28:48 dkf Exp $ '\" .so man.macros .TH tclvars n 8.0 Tcl "Tcl Built-In Commands" @@ -245,10 +245,6 @@ retrieve any relevant information. In addition, extensions and applications may add additional values to the array. The predefined elements are: - - - - .RS .VS .TP @@ -295,6 +291,12 @@ This identifies the current user based on the login information available on the platform. This comes from the USER or LOGNAME environment variable on Unix, and the value from GetUserName on Windows and Macintosh. +.TP +\fBwordSize\fR +.VS 8.4 +This gives the size of the native-machine word in bytes (strictly, it +is same as the result of evaluating \fIsizeof(long)\fR in C.) +.VE 8.4 .RE .TP \fBtcl_precision\fR diff --git a/generic/tcl.decls b/generic/tcl.decls index 9e6e3b4..915571e 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.82 2002/02/10 20:36:33 kennykb Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.83 2002/02/15 14:28:48 dkf Exp $ library tcl @@ -29,12 +29,11 @@ hooks {tclPlat tclInt tclIntPlat} declare 0 generic { int Tcl_PkgProvideEx( Tcl_Interp* interp, CONST char* name, - CONST char* version, ClientData clientData ) + CONST char* version, ClientData clientData ) } declare 1 generic { CONST char * Tcl_PkgRequireEx( Tcl_Interp *interp, CONST char *name, - CONST char *version, - int exact, ClientData *clientDataPtr ) + CONST char *version, int exact, ClientData *clientDataPtr ) } declare 2 generic { void Tcl_Panic(CONST char *format, ...) @@ -56,7 +55,7 @@ declare 7 generic { } declare 8 generic { char * Tcl_DbCkrealloc(char *ptr, unsigned int size, - CONST char *file, int line) + CONST char *file, int line) } # Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix, @@ -64,7 +63,7 @@ declare 8 generic { # compatibility reasons. declare 9 unix { - void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, \ + void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData) } declare 10 unix { @@ -93,7 +92,7 @@ declare 17 generic { Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *CONST objv[]) } declare 18 generic { - int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, \ + int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_ObjType *typePtr) } declare 19 generic { @@ -109,16 +108,16 @@ declare 22 generic { Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, CONST char *file, int line) } declare 23 generic { - Tcl_Obj * Tcl_DbNewByteArrayObj(CONST unsigned char *bytes, int length, \ + Tcl_Obj * Tcl_DbNewByteArrayObj(CONST unsigned char *bytes, int length, CONST char *file, int line) } declare 24 generic { Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, - CONST char *file, int line) + CONST char *file, int line) } declare 25 generic { Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *CONST *objv, - CONST char *file, int line) + CONST char *file, int line) } declare 26 generic { Tcl_Obj * Tcl_DbNewLongObj(long longValue, CONST char *file, int line) @@ -128,7 +127,7 @@ declare 27 generic { } declare 28 generic { Tcl_Obj * Tcl_DbNewStringObj(CONST char *bytes, int length, - CONST char *file, int line) + CONST char *file, int line) } declare 29 generic { Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr) @@ -140,7 +139,7 @@ declare 31 generic { int Tcl_GetBoolean(Tcl_Interp *interp, CONST char *str, int *boolPtr) } declare 32 generic { - int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \ + int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr) } declare 33 generic { @@ -150,11 +149,11 @@ declare 34 generic { int Tcl_GetDouble(Tcl_Interp *interp, CONST char *str, double *doublePtr) } declare 35 generic { - int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \ + int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr) } declare 36 generic { - int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \ + int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr) } declare 37 generic { @@ -176,34 +175,34 @@ declare 42 generic { void Tcl_InvalidateStringRep(Tcl_Obj *objPtr) } declare 43 generic { - int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr, \ + int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr) } declare 44 generic { - int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, \ + int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr) } declare 45 generic { - int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, \ + int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr) } declare 46 generic { - int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, \ + int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr) } declare 47 generic { - int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, int *intPtr) + int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, + int *lengthPtr) } declare 48 generic { - int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, \ + int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[]) } declare 49 generic { - Tcl_Obj * Tcl_NewBooleanObj(int boolValue) + Tcl_Obj *Tcl_NewBooleanObj(int boolValue) } declare 50 generic { - Tcl_Obj * Tcl_NewByteArrayObj( CONST unsigned char* bytes, - int length ) + Tcl_Obj *Tcl_NewByteArrayObj(CONST unsigned char* bytes, int length) } declare 51 generic { Tcl_Obj * Tcl_NewDoubleObj(double doubleValue) @@ -231,7 +230,7 @@ declare 58 generic { } declare 59 generic { void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, CONST unsigned char *bytes, - int length) + int length) } declare 60 generic { void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue) @@ -255,7 +254,7 @@ declare 66 generic { void Tcl_AddErrorInfo(Tcl_Interp *interp, CONST char *message) } declare 67 generic { - void Tcl_AddObjErrorInfo(Tcl_Interp *interp, CONST char *message, \ + void Tcl_AddObjErrorInfo(Tcl_Interp *interp, CONST char *message, int length) } declare 68 generic { @@ -268,7 +267,7 @@ declare 70 generic { void Tcl_AppendResult(Tcl_Interp *interp, ...) } declare 71 generic { - Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, \ + Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, ClientData clientData) } declare 72 generic { @@ -290,11 +289,11 @@ declare 77 generic { char Tcl_Backslash(CONST char *src, int *readPtr) } declare 78 generic { - int Tcl_BadChannelOption(Tcl_Interp *interp, CONST char *optionName, \ + int Tcl_BadChannelOption(Tcl_Interp *interp, CONST char *optionName, CONST char *optionList) } declare 79 generic { - void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, \ + void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData) } declare 80 generic { @@ -313,17 +312,17 @@ declare 84 generic { int Tcl_ConvertElement(CONST char *src, char *dst, int flags) } declare 85 generic { - int Tcl_ConvertCountedElement(CONST char *src, int length, char *dst, \ + int Tcl_ConvertCountedElement(CONST char *src, int length, char *dst, int flags) } declare 86 generic { - int Tcl_CreateAlias(Tcl_Interp *slave, CONST char *slaveCmd, \ - Tcl_Interp *target, CONST char *targetCmd, int argc, \ + int Tcl_CreateAlias(Tcl_Interp *slave, CONST char *slaveCmd, + Tcl_Interp *target, CONST char *targetCmd, int argc, char * CONST *argv) } declare 87 generic { - int Tcl_CreateAliasObj(Tcl_Interp *slave, CONST char *slaveCmd, \ - Tcl_Interp *target, CONST char *targetCmd, int objc, \ + int Tcl_CreateAliasObj(Tcl_Interp *slave, CONST char *slaveCmd, + Tcl_Interp *target, CONST char *targetCmd, int objc, Tcl_Obj *CONST objv[]) } declare 88 generic { @@ -331,20 +330,20 @@ declare 88 generic { CONST char *chanName, ClientData instanceData, int mask) } declare 89 generic { - void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, \ + void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData) } declare 90 generic { - void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, \ + void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData) } declare 91 generic { - Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, CONST char *cmdName, \ - Tcl_CmdProc *proc, ClientData clientData, \ + Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, CONST char *cmdName, + Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc) } declare 92 generic { - void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, \ + void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData) } declare 93 generic { @@ -354,37 +353,37 @@ declare 94 generic { Tcl_Interp * Tcl_CreateInterp(void) } declare 95 generic { - void Tcl_CreateMathFunc(Tcl_Interp *interp, CONST char *name, \ - int numArgs, Tcl_ValueType *argTypes, - Tcl_MathProc *proc, ClientData clientData) + void Tcl_CreateMathFunc(Tcl_Interp *interp, CONST char *name, + int numArgs, Tcl_ValueType *argTypes, + Tcl_MathProc *proc, ClientData clientData) } declare 96 generic { - Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, \ - CONST char *cmdName, \ - Tcl_ObjCmdProc *proc, ClientData clientData, \ + Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, + CONST char *cmdName, + Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc) } declare 97 generic { - Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, CONST char *slaveName, \ + Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, CONST char *slaveName, int isSafe) } declare 98 generic { - Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, \ + Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, Tcl_TimerProc *proc, ClientData clientData) } declare 99 generic { - Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, \ + Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData) } declare 100 generic { void Tcl_DeleteAssocData(Tcl_Interp *interp, CONST char *name) } declare 101 generic { - void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, \ + void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData) } declare 102 generic { - void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, \ + void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData) } declare 103 generic { @@ -397,7 +396,7 @@ declare 105 generic { void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData) } declare 106 generic { - void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, \ + void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData) } declare 107 generic { @@ -422,7 +421,7 @@ declare 113 generic { void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace) } declare 114 generic { - void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, \ + void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData) } declare 115 generic { @@ -432,12 +431,10 @@ declare 116 generic { void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData) } declare 117 generic { - char * Tcl_DStringAppend(Tcl_DString *dsPtr, CONST char *str, \ - int length) + char * Tcl_DStringAppend(Tcl_DString *dsPtr, CONST char *str, int length) } declare 118 generic { - char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, \ - CONST char *string) + char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, CONST char *string) } declare 119 generic { void Tcl_DStringEndSublist(Tcl_DString *dsPtr) @@ -486,7 +483,7 @@ declare 133 generic { void Tcl_Exit(int status) } declare 134 generic { - int Tcl_ExposeCommand(Tcl_Interp *interp, CONST char *hiddenCmdToken, \ + int Tcl_ExposeCommand(Tcl_Interp *interp, CONST char *hiddenCmdToken, CONST char *cmdName) } declare 135 generic { @@ -508,7 +505,7 @@ declare 140 generic { int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr) } declare 141 generic { - int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \ + int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr) } declare 142 generic { @@ -521,7 +518,7 @@ declare 144 generic { void Tcl_FindExecutable(CONST char *argv0) } declare 145 generic { - Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, \ + Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) } declare 146 generic { @@ -531,28 +528,28 @@ declare 147 generic { void Tcl_FreeResult(Tcl_Interp *interp) } declare 148 generic { - int Tcl_GetAlias(Tcl_Interp *interp, CONST char *slaveCmd, \ - Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, \ + int Tcl_GetAlias(Tcl_Interp *interp, CONST char *slaveCmd, + Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, char ***argvPtr) } declare 149 generic { - int Tcl_GetAliasObj(Tcl_Interp *interp, CONST char *slaveCmd, \ - Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, \ + int Tcl_GetAliasObj(Tcl_Interp *interp, CONST char *slaveCmd, + Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv) } declare 150 generic { - ClientData Tcl_GetAssocData(Tcl_Interp *interp, CONST char *name, \ + ClientData Tcl_GetAssocData(Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc **procPtr) } declare 151 generic { - Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, CONST char *chanName, \ + Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, CONST char *chanName, int *modePtr) } declare 152 generic { int Tcl_GetChannelBufferSize(Tcl_Channel chan) } declare 153 generic { - int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, \ + int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, ClientData *handlePtr) } declare 154 generic { @@ -565,14 +562,14 @@ declare 156 generic { CONST char * Tcl_GetChannelName(Tcl_Channel chan) } declare 157 generic { - int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, \ + int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, Tcl_DString *dsPtr) } declare 158 generic { Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan) } declare 159 generic { - int Tcl_GetCommandInfo(Tcl_Interp *interp, CONST char *cmdName, \ + int Tcl_GetCommandInfo(Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdInfo *infoPtr) } declare 160 generic { @@ -601,7 +598,7 @@ declare 166 generic { # generic interface, so we inlcude it here for compatibility reasons. declare 167 unix { - int Tcl_GetOpenFile(Tcl_Interp *interp, CONST char *str, int forWriting, \ + int Tcl_GetOpenFile(Tcl_Interp *interp, CONST char *str, int forWriting, int checkUsage, ClientData *filePtr) } # Obsolete. Should now use Tcl_FSGetPathType which is objectified @@ -631,7 +628,7 @@ declare 175 generic { CONST char * Tcl_GetVar(Tcl_Interp *interp, char *varName, int flags) } declare 176 generic { - CONST char * Tcl_GetVar2(Tcl_Interp *interp, char *part1, char *part2, \ + CONST char * Tcl_GetVar2(Tcl_Interp *interp, char *part1, char *part2, int flags) } declare 177 generic { @@ -641,7 +638,7 @@ declare 178 generic { int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 179 generic { - int Tcl_HideCommand(Tcl_Interp *interp, CONST char *cmdName, \ + int Tcl_HideCommand(Tcl_Interp *interp, CONST char *cmdName, CONST char *hiddenCmdToken) } declare 180 generic { @@ -695,29 +692,29 @@ declare 194 generic { void Tcl_NotifyChannel(Tcl_Channel channel, int mask) } declare 195 generic { - Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, \ + Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags) } declare 196 generic { - Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, \ + Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags) } declare 197 {unix win} { - Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, \ + Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags) } # This is obsolete, use Tcl_FSOpenFileChannel declare 198 generic { - Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, CONST char *fileName, \ + Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions) } declare 199 generic { - Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, \ + Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, CONST char *address, CONST char *myaddr, int myport, int async) } declare 200 generic { - Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, \ - CONST char *host, Tcl_TcpAcceptProc *acceptProc, \ + Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, + CONST char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData) } declare 201 generic { @@ -757,15 +754,15 @@ declare 212 generic { Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, CONST char *string) } declare 213 generic { - int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, \ + int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, CONST char *str, CONST char *start) } declare 214 generic { - int Tcl_RegExpMatch(Tcl_Interp *interp, CONST char *str, \ + int Tcl_RegExpMatch(Tcl_Interp *interp, CONST char *str, CONST char *pattern) } declare 215 generic { - void Tcl_RegExpRange(Tcl_RegExp regexp, int index, \ + void Tcl_RegExpRange(Tcl_RegExp regexp, int index, CONST char **startPtr, CONST char **endPtr) } declare 216 generic { @@ -780,8 +777,9 @@ declare 218 generic { declare 219 generic { int Tcl_ScanCountedElement(CONST char *str, int length, int *flagPtr) } +# Obsolete declare 220 generic { - int Tcl_Seek(Tcl_Channel chan, int offset, int mode) + int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) } declare 221 generic { int Tcl_ServiceAll(void) @@ -790,18 +788,18 @@ declare 222 generic { int Tcl_ServiceEvent(int flags) } declare 223 generic { - void Tcl_SetAssocData(Tcl_Interp *interp, CONST char *name, \ + void Tcl_SetAssocData(Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc *proc, ClientData clientData) } declare 224 generic { void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz) } declare 225 generic { - int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, \ + int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, CONST char *newValue) } declare 226 generic { - int Tcl_SetCommandInfo(Tcl_Interp *interp, CONST char *cmdName, \ + int Tcl_SetCommandInfo(Tcl_Interp *interp, CONST char *cmdName, CONST Tcl_CmdInfo *infoPtr) } declare 227 generic { @@ -820,7 +818,7 @@ declare 231 generic { int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth) } declare 232 generic { - void Tcl_SetResult(Tcl_Interp *interp, char *str, \ + void Tcl_SetResult(Tcl_Interp *interp, char *str, Tcl_FreeProc *freeProc) } declare 233 generic { @@ -836,11 +834,11 @@ declare 236 generic { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } declare 237 generic { - CONST char * Tcl_SetVar(Tcl_Interp *interp, char *varName, \ + CONST char * Tcl_SetVar(Tcl_Interp *interp, char *varName, CONST char *newValue, int flags) } declare 238 generic { - CONST char * Tcl_SetVar2(Tcl_Interp *interp, char *part1, char *part2, \ + CONST char * Tcl_SetVar2(Tcl_Interp *interp, char *part1, char *part2, CONST char *newValue, int flags) } declare 239 generic { @@ -853,7 +851,7 @@ declare 241 generic { void Tcl_SourceRCFile(Tcl_Interp *interp) } declare 242 generic { - int Tcl_SplitList(Tcl_Interp *interp, CONST char *listStr, int *argcPtr, \ + int Tcl_SplitList(Tcl_Interp *interp, CONST char *listStr, int *argcPtr, CONST84 char ***argvPtr) } # Obsolete, use Tcl_FSSplitPath @@ -861,25 +859,26 @@ declare 243 generic { void Tcl_SplitPath(CONST char *path, int *argcPtr, CONST84 char ***argvPtr) } declare 244 generic { - void Tcl_StaticPackage(Tcl_Interp *interp, CONST char *pkgName, \ + void Tcl_StaticPackage(Tcl_Interp *interp, CONST char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc) } declare 245 generic { int Tcl_StringMatch(CONST char *str, CONST char *pattern) } +# Obsolete declare 246 generic { - int Tcl_Tell(Tcl_Channel chan) + int Tcl_TellOld(Tcl_Channel chan) } declare 247 generic { - int Tcl_TraceVar(Tcl_Interp *interp, char *varName, int flags, \ + int Tcl_TraceVar(Tcl_Interp *interp, char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 248 generic { - int Tcl_TraceVar2(Tcl_Interp *interp, char *part1, char *part2, \ + int Tcl_TraceVar2(Tcl_Interp *interp, char *part1, char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 249 generic { - char * Tcl_TranslateFileName(Tcl_Interp *interp, CONST char *name, \ + char * Tcl_TranslateFileName(Tcl_Interp *interp, CONST char *name, Tcl_DString *bufferPtr) } declare 250 generic { @@ -898,41 +897,41 @@ declare 254 generic { int Tcl_UnsetVar2(Tcl_Interp *interp, char *part1, char *part2, int flags) } declare 255 generic { - void Tcl_UntraceVar(Tcl_Interp *interp, char *varName, int flags, \ + void Tcl_UntraceVar(Tcl_Interp *interp, char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 256 generic { - void Tcl_UntraceVar2(Tcl_Interp *interp, char *part1, char *part2, \ + void Tcl_UntraceVar2(Tcl_Interp *interp, char *part1, char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 257 generic { void Tcl_UpdateLinkedVar(Tcl_Interp *interp, char *varName) } declare 258 generic { - int Tcl_UpVar(Tcl_Interp *interp, CONST char *frameName, char *varName, \ + int Tcl_UpVar(Tcl_Interp *interp, CONST char *frameName, char *varName, CONST char *localName, int flags) } declare 259 generic { - int Tcl_UpVar2(Tcl_Interp *interp, CONST char *frameName, char *part1, \ + int Tcl_UpVar2(Tcl_Interp *interp, CONST char *frameName, char *part1, char *part2, CONST char *localName, int flags) } declare 260 generic { int Tcl_VarEval(Tcl_Interp *interp, ...) } declare 261 generic { - ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, char *varName, \ + ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) } declare 262 generic { - ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, char *part1, \ - char *part2, int flags, Tcl_VarTraceProc *procPtr, \ + ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, char *part1, + char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) } declare 263 generic { int Tcl_Write(Tcl_Channel chan, CONST char *s, int slen) } declare 264 generic { - void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, \ + void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], CONST char *message) } declare 265 generic { @@ -956,20 +955,19 @@ declare 270 generic { } declare 271 generic { CONST char * Tcl_PkgPresent(Tcl_Interp *interp, CONST char *name, - CONST char *version, int exact) + CONST char *version, int exact) } declare 272 generic { CONST char * Tcl_PkgPresentEx(Tcl_Interp *interp, CONST char *name, - CONST char *version, int exact, - ClientData *clientDataPtr) + CONST char *version, int exact, ClientData *clientDataPtr) } declare 273 generic { int Tcl_PkgProvide(Tcl_Interp *interp, CONST char *name, - CONST char *version) + CONST char *version) } declare 274 generic { CONST char * Tcl_PkgRequire(Tcl_Interp *interp, CONST char *name, - CONST char *version, int exact) + CONST char *version, int exact) } declare 275 generic { void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) @@ -1005,9 +1003,8 @@ declare 280 generic { # version into the new one). declare 281 generic { - Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, \ - Tcl_ChannelType *typePtr, ClientData instanceData, \ - int mask, Tcl_Channel prevChan) + Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, Tcl_ChannelType *typePtr, + ClientData instanceData, int mask, Tcl_Channel prevChan) } declare 282 generic { int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan) @@ -1047,7 +1044,7 @@ declare 291 generic { int Tcl_EvalEx(Tcl_Interp *interp, char *script, int numBytes, int flags) } declare 292 generic { - int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], \ + int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags) } declare 293 generic { @@ -1057,13 +1054,13 @@ declare 294 generic { void Tcl_ExitThread(int status) } declare 295 generic { - int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, \ - CONST char *src, int srcLen, int flags, \ - Tcl_EncodingState *statePtr, char *dst, int dstLen, \ + int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, + CONST char *src, int srcLen, int flags, + Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr) } declare 296 generic { - char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, \ + char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr) } declare 297 generic { @@ -1088,15 +1085,15 @@ declare 303 generic { void Tcl_GetEncodingNames(Tcl_Interp *interp) } declare 304 generic { - int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, \ - CONST char **tablePtr, int offset, CONST char *msg, int flags, \ + int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, + CONST char **tablePtr, int offset, CONST char *msg, int flags, int *indexPtr) } declare 305 generic { VOID * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size) } declare 306 generic { - Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, char *part1, char *part2, \ + Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, char *part1, char *part2, int flags) } declare 307 generic { @@ -1112,14 +1109,14 @@ declare 310 generic { void Tcl_ConditionNotify(Tcl_Condition *condPtr) } declare 311 generic { - void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, \ + void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, Tcl_Time *timePtr) } declare 312 generic { int Tcl_NumUtfChars(CONST char *src, int len) } declare 313 generic { - int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, \ + int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag) } declare 314 generic { @@ -1132,14 +1129,14 @@ declare 316 generic { int Tcl_SetSystemEncoding(Tcl_Interp *interp, CONST char *name) } declare 317 generic { - Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, char *part1, char *part2, \ + Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, char *part1, char *part2, Tcl_Obj *newValuePtr, int flags) } declare 318 generic { void Tcl_ThreadAlert(Tcl_ThreadId threadId) } declare 319 generic { - void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event* evPtr, \ + void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event* evPtr, Tcl_QueuePosition position) } declare 320 generic { @@ -1179,13 +1176,13 @@ declare 331 generic { CONST char * Tcl_UtfPrev(CONST char *src, CONST char *start) } declare 332 generic { - int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, \ - CONST char *src, int srcLen, int flags, \ - Tcl_EncodingState *statePtr, char *dst, int dstLen, \ + int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, + CONST char *src, int srcLen, int flags, + Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr) } declare 333 generic { - char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, \ + char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr) } declare 334 generic { @@ -1246,51 +1243,52 @@ declare 352 generic { int Tcl_UniCharLen(CONST Tcl_UniChar *str) } declare 353 generic { - int Tcl_UniCharNcmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct,\ - unsigned long n) + int Tcl_UniCharNcmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, + unsigned long n) } declare 354 generic { - char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *string, \ + char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *string, int numChars, Tcl_DString *dsPtr) } declare 355 generic { - Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *string, \ + Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *string, int length, Tcl_DString *dsPtr) } declare 356 generic { - Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) + Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, + int flags) } declare 357 generic { - Tcl_Obj *Tcl_EvalTokens (Tcl_Interp *interp, Tcl_Token *tokenPtr, \ + Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count) } declare 358 generic { - void Tcl_FreeParse (Tcl_Parse *parsePtr) + void Tcl_FreeParse(Tcl_Parse *parsePtr) } declare 359 generic { - void Tcl_LogCommandInfo (Tcl_Interp *interp, CONST char *script, \ + void Tcl_LogCommandInfo(Tcl_Interp *interp, CONST char *script, CONST char *command, int length) } declare 360 generic { - int Tcl_ParseBraces (Tcl_Interp *interp, char *string, \ + int Tcl_ParseBraces(Tcl_Interp *interp, char *string, int numBytes, Tcl_Parse *parsePtr, int append, char **termPtr) } declare 361 generic { - int Tcl_ParseCommand (Tcl_Interp *interp, char *string, int numBytes, \ + int Tcl_ParseCommand(Tcl_Interp *interp, char *string, int numBytes, int nested, Tcl_Parse *parsePtr) } declare 362 generic { - int Tcl_ParseExpr(Tcl_Interp *interp, char *string, int numBytes, \ + int Tcl_ParseExpr(Tcl_Interp *interp, char *string, int numBytes, Tcl_Parse *parsePtr) } declare 363 generic { - int Tcl_ParseQuotedString(Tcl_Interp *interp, char *string, int numBytes, \ + int Tcl_ParseQuotedString(Tcl_Interp *interp, char *string, int numBytes, Tcl_Parse *parsePtr, int append, char **termPtr) } declare 364 generic { - int Tcl_ParseVarName (Tcl_Interp *interp, char *string, \ - int numBytes, Tcl_Parse *parsePtr, int append) + int Tcl_ParseVarName(Tcl_Interp *interp, char *string, int numBytes, + Tcl_Parse *parsePtr, int append) } # These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir, # Tcl_FSAccess and Tcl_FSStat @@ -1328,7 +1326,7 @@ declare 375 generic { int Tcl_UniCharIsPunct(int ch) } declare 376 generic { - int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, \ + int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *objPtr, int offset, int nmatches, int flags) } declare 377 generic { @@ -1339,26 +1337,26 @@ declare 378 generic { } declare 379 generic { void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, - int numChars) + int numChars) } declare 380 generic { - int Tcl_GetCharLength (Tcl_Obj *objPtr) + int Tcl_GetCharLength(Tcl_Obj *objPtr) } declare 381 generic { - Tcl_UniChar Tcl_GetUniChar (Tcl_Obj *objPtr, int index) + Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index) } declare 382 generic { - Tcl_UniChar * Tcl_GetUnicode (Tcl_Obj *objPtr) + Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr) } declare 383 generic { - Tcl_Obj * Tcl_GetRange (Tcl_Obj *objPtr, int first, int last) + Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last) } declare 384 generic { - void Tcl_AppendUnicodeToObj (Tcl_Obj *objPtr, - CONST Tcl_UniChar *unicode, int length) + void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, + int length) } declare 385 generic { - int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *stringObj, \ + int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Obj *patternObj) } declare 386 generic { @@ -1374,32 +1372,32 @@ declare 389 generic { int Tcl_GetChannelNamesEx(Tcl_Interp *interp, CONST char *pattern) } declare 390 generic { - int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, \ + int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) } declare 391 generic { - void Tcl_ConditionFinalize (Tcl_Condition *condPtr) + void Tcl_ConditionFinalize(Tcl_Condition *condPtr) } declare 392 generic { - void Tcl_MutexFinalize (Tcl_Mutex *mutex) + void Tcl_MutexFinalize(Tcl_Mutex *mutex) } declare 393 generic { - int Tcl_CreateThread (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, \ + int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags) } # Introduced in 8.3.2 declare 394 generic { - int Tcl_ReadRaw (Tcl_Channel chan, char *dst, int bytesToRead) + int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead) } declare 395 generic { - int Tcl_WriteRaw (Tcl_Channel chan, CONST char *src, int srcLen) + int Tcl_WriteRaw(Tcl_Channel chan, CONST char *src, int srcLen) } declare 396 generic { - Tcl_Channel Tcl_GetTopChannel (Tcl_Channel chan) + Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan) } declare 397 generic { - int Tcl_ChannelBuffered (Tcl_Channel chan) + int Tcl_ChannelBuffered(Tcl_Channel chan) } declare 398 generic { CONST char * Tcl_ChannelName(Tcl_ChannelType *chanTypePtr) @@ -1408,7 +1406,7 @@ declare 399 generic { Tcl_ChannelTypeVersion Tcl_ChannelVersion(Tcl_ChannelType *chanTypePtr) } declare 400 generic { - Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(Tcl_ChannelType \ + Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(Tcl_ChannelType *chanTypePtr) } declare 401 generic { @@ -1427,72 +1425,71 @@ declare 405 generic { Tcl_DriverSeekProc * Tcl_ChannelSeekProc(Tcl_ChannelType *chanTypePtr) } declare 406 generic { - Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(Tcl_ChannelType \ + Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(Tcl_ChannelType *chanTypePtr) } declare 407 generic { - Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(Tcl_ChannelType \ + Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(Tcl_ChannelType *chanTypePtr) } declare 408 generic { Tcl_DriverWatchProc * Tcl_ChannelWatchProc(Tcl_ChannelType *chanTypePtr) } declare 409 generic { - Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(Tcl_ChannelType \ + Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(Tcl_ChannelType *chanTypePtr) } declare 410 generic { Tcl_DriverFlushProc * Tcl_ChannelFlushProc(Tcl_ChannelType *chanTypePtr) } declare 411 generic { - Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(Tcl_ChannelType \ + Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(Tcl_ChannelType *chanTypePtr) } # Introduced in 8.4a2 declare 412 generic { - int Tcl_JoinThread (Tcl_ThreadId id, int* result) + int Tcl_JoinThread(Tcl_ThreadId id, int* result) } declare 413 generic { - int Tcl_IsChannelShared (Tcl_Channel channel) + int Tcl_IsChannelShared(Tcl_Channel channel) } declare 414 generic { - int Tcl_IsChannelRegistered (Tcl_Interp* interp, Tcl_Channel channel) + int Tcl_IsChannelRegistered(Tcl_Interp* interp, Tcl_Channel channel) } declare 415 generic { - void Tcl_CutChannel (Tcl_Channel channel) + void Tcl_CutChannel(Tcl_Channel channel) } declare 416 generic { - void Tcl_SpliceChannel (Tcl_Channel channel) + void Tcl_SpliceChannel(Tcl_Channel channel) } declare 417 generic { - void Tcl_ClearChannelHandlers (Tcl_Channel channel) + void Tcl_ClearChannelHandlers(Tcl_Channel channel) } declare 418 generic { - int Tcl_IsChannelExisting (CONST char* channelName) + int Tcl_IsChannelExisting(CONST char* channelName) } declare 419 generic { - int Tcl_UniCharNcasecmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct,\ + int Tcl_UniCharNcasecmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, unsigned long n) } declare 420 generic { - int Tcl_UniCharCaseMatch(CONST Tcl_UniChar *ustr, \ + int Tcl_UniCharCaseMatch(CONST Tcl_UniChar *ustr, CONST Tcl_UniChar *pattern, int nocase) } declare 421 generic { - Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, \ - CONST char *key) + Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, CONST char *key) } declare 422 generic { - Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, \ + Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, CONST char *key, int *newPtr) } declare 423 generic { - void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, \ + void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, Tcl_HashKeyType *typePtr) } @@ -1500,15 +1497,16 @@ declare 424 generic { void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr) } declare 425 generic { - ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, CONST char *varName, \ - int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData) + ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, CONST char *varName, + int flags, Tcl_CommandTraceProc *procPtr, + ClientData prevClientData) } declare 426 generic { - int Tcl_TraceCommand(Tcl_Interp *interp, CONST char *varName, int flags, \ + int Tcl_TraceCommand(Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData) } declare 427 generic { - void Tcl_UntraceCommand(Tcl_Interp *interp, CONST char *varName, \ + void Tcl_UntraceCommand(Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData) } declare 428 generic { @@ -1532,12 +1530,12 @@ declare 433 generic { } # introduced in 8.4a3 declare 434 generic { - Tcl_UniChar * Tcl_GetUnicodeFromObj (Tcl_Obj *objPtr, int *lengthPtr) + Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) } declare 435 generic { - int Tcl_GetMathFuncInfo(Tcl_Interp *interp, CONST char *name, \ - int *numArgsPtr, Tcl_ValueType **argTypesPtr, \ - Tcl_MathProc **procPtr, ClientData *clientDataPtr) + int Tcl_GetMathFuncInfo(Tcl_Interp *interp, CONST char *name, + int *numArgsPtr, Tcl_ValueType **argTypesPtr, + Tcl_MathProc **procPtr, ClientData *clientDataPtr) } declare 436 generic { Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, CONST char *pattern) @@ -1556,8 +1554,8 @@ declare 440 generic { int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) } declare 441 generic { - int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr, \ - Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr) + int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr) } declare 442 generic { int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr) @@ -1566,55 +1564,52 @@ declare 443 generic { int Tcl_FSDeleteFile(Tcl_Obj *pathPtr) } declare 444 generic { - int Tcl_FSLoadFile(Tcl_Interp * interp, \ - Tcl_Obj *pathPtr, CONST char * sym1, CONST char * sym2, \ - Tcl_PackageInitProc ** proc1Ptr, \ - Tcl_PackageInitProc ** proc2Ptr, \ - ClientData * clientDataPtr, \ - Tcl_FSUnloadFileProc **unloadProcPtr) + int Tcl_FSLoadFile(Tcl_Interp * interp, + Tcl_Obj *pathPtr, CONST char * sym1, CONST char * sym2, + Tcl_PackageInitProc ** proc1Ptr, + Tcl_PackageInitProc ** proc2Ptr, + ClientData * clientDataPtr, + Tcl_FSUnloadFileProc **unloadProcPtr) } declare 445 generic { - int Tcl_FSMatchInDirectory(Tcl_Interp *interp, Tcl_Obj * result, \ - Tcl_Obj *pathPtr, \ - CONST char * pattern, Tcl_GlobTypeData * types) + int Tcl_FSMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *result, + Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types) } declare 446 generic { - Tcl_Obj* Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr) + Tcl_Obj * Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr) } declare 447 generic { - int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr, \ - int recursive, Tcl_Obj **errorPtr) + int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr, + int recursive, Tcl_Obj **errorPtr) } declare 448 generic { int Tcl_FSRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) } declare 449 generic { - int Tcl_FSLstat(Tcl_Obj *pathPtr, struct stat *buf) + int Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) } declare 450 generic { int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval) } declare 451 generic { - int Tcl_FSFileAttrsGet(Tcl_Interp *interp, \ - int index, Tcl_Obj *pathPtr, \ - Tcl_Obj **objPtrRef) + int Tcl_FSFileAttrsGet(Tcl_Interp *interp, + int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) } declare 452 generic { - int Tcl_FSFileAttrsSet(Tcl_Interp *interp, \ - int index, Tcl_Obj *pathPtr, \ - Tcl_Obj *objPtr) + int Tcl_FSFileAttrsSet(Tcl_Interp *interp, + int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr) } declare 453 generic { CONST char ** Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) } declare 454 generic { - int Tcl_FSStat(Tcl_Obj *pathPtr, struct stat *buf) + int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) } declare 455 generic { int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode) } declare 456 generic { - Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, \ + Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *modeString, int permissions) } declare 457 generic { @@ -1639,10 +1634,12 @@ declare 463 generic { Tcl_Obj* Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj* pathObjPtr) } declare 464 generic { - Tcl_Obj* Tcl_FSJoinToPath(Tcl_Obj *basePtr, int objc, Tcl_Obj *CONST objv[]) + Tcl_Obj* Tcl_FSJoinToPath(Tcl_Obj *basePtr, int objc, + Tcl_Obj *CONST objv[]) } declare 465 generic { - ClientData Tcl_FSGetInternalRep(Tcl_Obj* pathObjPtr, Tcl_Filesystem *fsPtr) + ClientData Tcl_FSGetInternalRep(Tcl_Obj* pathObjPtr, + Tcl_Filesystem *fsPtr) } declare 466 generic { Tcl_Obj* Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr) @@ -1651,7 +1648,8 @@ declare 467 generic { int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName) } declare 468 generic { - Tcl_Obj* Tcl_FSNewNativePath(Tcl_Obj* fromFilesystem, ClientData clientData) + Tcl_Obj* Tcl_FSNewNativePath(Tcl_Obj* fromFilesystem, + ClientData clientData) } declare 469 generic { CONST char* Tcl_FSGetNativePath(Tcl_Obj* pathObjPtr) @@ -1675,14 +1673,14 @@ declare 475 generic { ClientData Tcl_FSData(Tcl_Filesystem *fsPtr) } declare 476 generic { - CONST char* Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, \ + CONST char* Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj* pathPtr) } declare 477 generic { Tcl_Filesystem* Tcl_FSGetFileSystemForPath(Tcl_Obj* pathObjPtr) } declare 478 generic { - Tcl_PathType Tcl_FSGetPathType (Tcl_Obj *pathObjPtr) + Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathObjPtr) } # New function due to TIP#49 declare 479 generic { @@ -1693,7 +1691,8 @@ declare 480 generic { } # New function due to TIP#56 declare 481 generic { - int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count) + int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, + int count) } # New export due to TIP#73 @@ -1720,6 +1719,31 @@ declare 485 generic { CONST Tcl_CmdInfo* infoPtr ) } +### New functions on 64-bit dev branch ### +declare 486 generic { + Tcl_Obj * Tcl_DbNewWideIntObj(Tcl_WideInt wideValue, + CONST char *file, int line) +} +declare 487 generic { + int Tcl_GetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + Tcl_WideInt *widePtr) +} +declare 488 generic { + Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue) +} +declare 489 generic { + void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue) +} +declare 490 generic { + Tcl_StatBuf * Tcl_AllocStatBuf(void) +} +declare 491 generic { + Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, int mode) +} +declare 492 generic { + Tcl_WideInt Tcl_Tell(Tcl_Channel chan) +} + ############################################################################## # Define the platform specific public Tcl interface. These functions are @@ -1733,12 +1757,10 @@ interface tclPlat # Added in Tcl 8.1 declare 0 win { - TCHAR * Tcl_WinUtfToTChar(CONST char *str, int len, \ - Tcl_DString *dsPtr) + TCHAR * Tcl_WinUtfToTChar(CONST char *str, int len, Tcl_DString *dsPtr) } declare 1 win { - char * Tcl_WinTCharToUtf(CONST TCHAR *str, int len, \ - Tcl_DString *dsPtr) + char * Tcl_WinTCharToUtf(CONST TCHAR *str, int len, Tcl_DString *dsPtr) } ################## @@ -1757,12 +1779,12 @@ declare 1 mac { char * Tcl_MacConvertTextResource(Handle resource) } declare 2 mac { - int Tcl_MacEvalResource(Tcl_Interp *interp, CONST char *resourceName, \ + int Tcl_MacEvalResource(Tcl_Interp *interp, CONST char *resourceName, int resourceNumber, CONST char *fileName) } declare 3 mac { - Handle Tcl_MacFindResource(Tcl_Interp *interp, long resourceType, \ - CONST char *resourceName, int resourceNumber, \ + Handle Tcl_MacFindResource(Tcl_Interp *interp, long resourceType, + CONST char *resourceName, int resourceNumber, CONST char *resFileRef, int * releaseIt) } @@ -1770,7 +1792,7 @@ declare 3 mac { # character type and creator codes). declare 4 mac { - int Tcl_GetOSTypeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \ + int Tcl_GetOSTypeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, OSType *osTypePtr) } declare 5 mac { diff --git a/generic/tcl.h b/generic/tcl.h index d9526b7..421e289 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.114 2002/02/10 20:36:34 kennykb Exp $ + * RCS: @(#) $Id: tcl.h,v 1.115 2002/02/15 14:28:48 dkf Exp $ */ #ifndef _TCL @@ -57,7 +57,6 @@ extern "C" { * tools/tcl.wse.in (for windows installer) * tools/tclSplash.bmp (not patchlevel) */ - #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 4 #define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE @@ -174,13 +173,14 @@ extern "C" { * this file. Resource compilers don't like all the C stuff, like typedefs * and procedure declarations, that occur below. */ - #ifndef RESOURCE_INCLUDED + #ifndef BUFSIZ -#include <stdio.h> +# include <stdio.h> #endif + /* * Definitions that allow Tcl functions with variable numbers of * arguments to be used with either varargs.h or stdarg.h. TCL_VARARGS @@ -190,27 +190,25 @@ extern "C" { * string for use in the function definition. TCL_VARARGS_START * initializes the va_list data structure and returns the first argument. */ - #if defined(__STDC__) || defined(HAS_STDARG) # include <stdarg.h> - # define TCL_VARARGS(type, name) (type name, ...) # define TCL_VARARGS_DEF(type, name) (type name, ...) # define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) #else # include <varargs.h> - # ifdef __cplusplus -# define TCL_VARARGS(type, name) (type name, ...) -# define TCL_VARARGS_DEF(type, name) (type va_alist, ...) +# define TCL_VARARGS(type, name) (type name, ...) +# define TCL_VARARGS_DEF(type, name) (type va_alist, ...) # else -# define TCL_VARARGS(type, name) () -# define TCL_VARARGS_DEF(type, name) (va_alist) +# define TCL_VARARGS(type, name) () +# define TCL_VARARGS_DEF(type, name) (va_alist) # endif # define TCL_VARARGS_START(type, name, list) \ (va_start(list), va_arg(list, type)) #endif + /* * Macros used to declare a function to be exported by a DLL. * Used by Windows, maps to no-op declarations on non-Windows systems. @@ -247,23 +245,22 @@ extern "C" { * storage class will be set to DLLEXPORT. At the end of the header file, the * storage class will be reset to DLLIMPORT. */ - #undef TCL_STORAGE_CLASS #ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT +# define TCL_STORAGE_CLASS DLLEXPORT #else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif +# ifdef USE_TCL_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif #endif + /* * Definitions that allow this header file to be used either with or * without ANSI C features like function prototypes. */ - #undef _ANSI_ARGS_ #undef CONST #ifndef INLINE @@ -285,11 +282,12 @@ extern "C" { # define CONST84 CONST #endif + /* * Make sure EXTERN isn't defined elsewhere */ #ifdef EXTERN -#undef EXTERN +# undef EXTERN #endif /* EXTERN */ #ifdef __cplusplus @@ -298,57 +296,139 @@ extern "C" { # define EXTERN extern TCL_STORAGE_CLASS #endif + /* * Macro to use instead of "void" for arguments that must have * type "void *" in ANSI C; maps them to type "char *" in * non-ANSI systems. */ #ifndef __WIN32__ -#ifndef VOID -# ifdef __STDC__ -# define VOID void -# else -# define VOID char +# ifndef VOID +# ifdef __STDC__ +# define VOID void +# else +# define VOID char +# endif # endif -#endif #else /* __WIN32__ */ /* * The following code is copied from winnt.h */ -#ifndef VOID -#define VOID void +# ifndef VOID +# define VOID void typedef char CHAR; typedef short SHORT; typedef long LONG; -#endif +# endif #endif /* __WIN32__ */ + /* * Miscellaneous declarations. */ - #ifndef NULL -#define NULL 0 +# define NULL 0 #endif #ifndef _CLIENTDATA # if defined(__STDC__) || defined(__cplusplus) || defined(__BORLANDC__) - typedef void *ClientData; +typedef void *ClientData; # else - typedef int *ClientData; +typedef int *ClientData; # endif /* __STDC__ */ -#define _CLIENTDATA +# define _CLIENTDATA #endif + +/* + * Define Tcl_WideInt to be a type that is (at least) 64-bits wide, + * and define Tcl_WideUInt to be the unsigned variant of that type + * (assuming that where we have one, we can have the other.) + * + * At the moment, this only works on Unix systems anyway... + * + * Also defines the following macros: + * TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on + * a real 64-bit system.) + * Tcl_WideAsLong - forgetful converter from wideInt to long. + * Tcl_LongAsWide - sign-extending converter from long to wideInt. + * Tcl_WideAsDouble - converter from wideInt to double. + * Tcl_DoubleAsWide - converter from double to wideInt. + * + * The following invariant should hold for any long value 'longVal': + * longVal == Tcl_WideAsLong(Tcl_LongAsWide(longVal)) + * + * Note on converting between Tcl_WideInt and strings. This + * implementation (in tclObj.c) depends on the functions strtoull() + * and, where sprintf(...,"%lld",...) does not work, lltostr(). + * Although strtoull() is fairly straight-forward, lltostr() is a most + * unusual function on Solaris8 (taking its operating buffer + * backwards) so any changes you make will need to be done + * cautiously... + */ +#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG) +# ifdef __WIN32__ +# define TCL_WIDE_INT_TYPE __int64 +# ifdef __BORLANDC__ +typedef struct stati64 Tcl_StatBuf; +# define TCL_LL_MODIFIER "L" +# define TCL_LL_MODIFIER_SIZE 1 +# else /* __BORLANDC__ */ +typedef struct _stati64 Tcl_StatBuf; +# define TCL_LL_MODIFIER "I64" +# define TCL_LL_MODIFIER_SIZE 3 +# endif /* __BORLANDC__ */ +# else /* __WIN32__ */ +/* + * Don't know what platform it is and configure hasn't been run! Assume + * it has no long long... + */ +# define TCL_WIDE_INT_IS_LONG 1 +# endif /* __WIN32__ */ +#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */ +#ifdef TCL_WIDE_INT_IS_LONG +# undef TCL_WIDE_INT_TYPE +# define TCL_WIDE_INT_TYPE long +#endif /* TCL_WIDE_INT_IS_LONG */ + +typedef TCL_WIDE_INT_TYPE Tcl_WideInt; +typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; + +#ifdef TCL_WIDE_INT_IS_LONG +# include <sys/types.h> +typedef struct stat Tcl_StatBuf; +# define Tcl_WideAsLong(val) ((long)(val)) +# define Tcl_LongAsWide(val) ((long)(val)) +# define Tcl_WideAsDouble(val) ((double)((long)(val))) +# define Tcl_DoubleAsWide(val) ((long)((double)(val))) +#else /* TCL_WIDE_INT_IS_LONG */ +# ifndef __WIN32__ +# include <sys/types.h> +# ifdef HAVE_STRUCT_STAT64 +typedef struct stat64 Tcl_StatBuf; +# else +typedef struct stat Tcl_StatBuf; +# endif /* HAVE_STRUCT_STAT64 */ +# define TCL_LL_MODIFIER "ll" +# define TCL_LL_MODIFIER_SIZE 2 +# endif /* !__WIN32__ */ +# define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val))) +# define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) +# define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) +# define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) +#endif /* TCL_WIDE_INT_IS_LONG */ + + /* * This flag controls whether binary compatability is maintained with * extensions built against a previous version of Tcl. This is true * by default. */ #ifndef TCL_PRESERVE_BINARY_COMPATABILITY -#define TCL_PRESERVE_BINARY_COMPATABILITY 1 +# define TCL_PRESERVE_BINARY_COMPATABILITY 1 #endif - + + /* * Data structures defined opaquely in this module. The definitions below * just provide dummy types. A few fields are made visible in Tcl_Interp @@ -401,13 +481,13 @@ typedef struct Tcl_Trace_ *Tcl_Trace; typedef struct Tcl_Var_ *Tcl_Var; typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion; + /* * Definition of the interface to procedures implementing threads. * A procedure following this definition is given to each call of * 'Tcl_CreateThread' and will be called as the main fuction of * the new thread created by that call. */ - #ifdef MAC_TCL typedef pascal void *(Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData)); #elif defined __WIN32__ @@ -434,12 +514,10 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData)); #endif - /* * Definition of values for default stacksize and the possible flags to be * given to Tcl_CreateThread. */ - #define TCL_THREAD_STACK_DEFAULT (0) /* Use default size for stack */ #define TCL_THREAD_NOFLAGS (0000) /* Standard flags, default behaviour */ #define TCL_THREAD_JOINABLE (0001) /* Mark the thread as joinable */ @@ -447,7 +525,6 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData)); /* * Flag values passed to Tcl_GetRegExpFromObj. */ - #define TCL_REG_BASIC 000000 /* BREs (convenience) */ #define TCL_REG_EXTENDED 000001 /* EREs */ #define TCL_REG_ADVF 000002 /* advanced features in EREs */ @@ -467,7 +544,6 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData)); * The following flag is experimental and only intended for use by Expect. It * will probably go away in a later release. */ - #define TCL_REG_BOSONLY 002000 /* prepend \A to pattern so it only * matches at the beginning of the * string. */ @@ -475,7 +551,6 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData)); /* * Flags values passed to Tcl_RegExpExecObj. */ - #define TCL_REG_NOTBOL 0001 /* Beginning of string does not match ^. */ #define TCL_REG_NOTEOL 0002 /* End of string does not match $. */ @@ -484,7 +559,6 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData)); * relative to the start of the match string, not the beginning of the * entire string. */ - typedef struct Tcl_RegExpIndices { long start; /* character offset of first character in match */ long end; /* character offset of first character after the @@ -505,8 +579,8 @@ typedef struct Tcl_RegExpInfo { * Picky compilers complain if this typdef doesn't appear before the * struct's reference in tclDecls.h. */ - -typedef struct stat *Tcl_Stat_; +typedef Tcl_StatBuf *Tcl_Stat_; +typedef struct stat *Tcl_OldStat_; /* * When a TCL command returns, the interpreter contains a result from the @@ -528,7 +602,6 @@ typedef struct stat *Tcl_Stat_; * TCL_CONTINUE Go on to the next iteration of the current loop; * the interpreter's result is meaningless. */ - #define TCL_OK 0 #define TCL_ERROR 1 #define TCL_RETURN 2 @@ -540,22 +613,29 @@ typedef struct stat *Tcl_Stat_; /* * Flags to control what substitutions are performed by Tcl_SubstObj(): */ - #define TCL_SUBST_COMMANDS 001 #define TCL_SUBST_VARIABLES 002 #define TCL_SUBST_BACKSLASHES 004 #define TCL_SUBST_ALL 007 + /* * Argument descriptors for math function callbacks in expressions: */ - -typedef enum {TCL_INT, TCL_DOUBLE, TCL_EITHER} Tcl_ValueType; +typedef enum { + TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT +#ifdef TCL_WIDE_INT_IS_LONG + = TCL_INT +#endif +} Tcl_ValueType; typedef struct Tcl_Value { Tcl_ValueType type; /* Indicates intValue or doubleValue is * valid, or both. */ long intValue; /* Integer value. */ double doubleValue; /* Double-precision floating value. */ +#ifndef TCL_WIDE_INT_IS_LONG + Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */ +#endif } Tcl_Value; /* @@ -563,9 +643,9 @@ typedef struct Tcl_Value { * reference to Tcl_Obj is encountered in the procedure types declared * below. */ - struct Tcl_Obj; + /* * Procedure types defined by Tcl: */ @@ -635,6 +715,7 @@ typedef void (Tcl_CreateFileHandlerProc) _ANSI_ARGS_((int fd, int mask, typedef void (Tcl_DeleteFileHandlerProc) _ANSI_ARGS_((int fd)); typedef void (Tcl_MainLoopProc) _ANSI_ARGS_((void)); + /* * The following structure represents a type of object, which is a * particular internal representation for an object plus a set of @@ -660,6 +741,7 @@ typedef struct Tcl_ObjType { * failure. */ } Tcl_ObjType; + /* * One of the following structures exists for each object in the Tcl * system. An object stores a value as either a string, some internal @@ -689,6 +771,7 @@ typedef struct Tcl_Obj { long longValue; /* - an long integer value */ double doubleValue; /* - a double-precision floating value */ VOID *otherValuePtr; /* - another, type-specific value */ + Tcl_WideInt wideValue; /* - a long long value */ struct { /* - internal rep as two pointers */ VOID *ptr1; VOID *ptr2; @@ -696,6 +779,7 @@ typedef struct Tcl_Obj { } internalRep; } Tcl_Obj; + /* * Macros to increment and decrement a Tcl_Obj's reference count, and to * test whether an object is shared (i.e. has reference count > 1). @@ -706,7 +790,6 @@ typedef struct Tcl_Obj { * "obj" twice. This means that you should avoid calling it with an * expression that is expensive to compute or has side effects. */ - void Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr)); void Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr)); int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr)); @@ -750,14 +833,16 @@ int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr)); Tcl_DbNewObj(__FILE__, __LINE__) # define Tcl_NewStringObj(bytes, len) \ Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__) +# define Tcl_NewWideIntObj(val) \ + Tcl_DbNewWideIntObj(val, __FILE__, __LINE__) #endif /* TCL_MEM_DEBUG */ + /* * The following structure contains the state needed by * Tcl_SaveResult. No-one outside of Tcl should access any of these * fields. This structure is typically allocated on the stack. */ - typedef struct Tcl_SavedResult { char *result; Tcl_FreeProc *freeProc; @@ -793,6 +878,7 @@ typedef struct Tcl_Namespace { * namespace. */ } Tcl_Namespace; + /* * The following structure represents a call frame, or activation record. * A call frame defines a naming context for a procedure call: its local @@ -829,6 +915,7 @@ typedef struct Tcl_CallFrame { char* dummy10; } Tcl_CallFrame; + /* * Information about commands that is returned by Tcl_GetCommandInfo and * passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based @@ -843,7 +930,7 @@ typedef struct Tcl_CallFrame { * does string-to-object or object-to-string argument conversions then * calls the other procedure. */ - + typedef struct Tcl_CmdInfo { int isNativeObjectProc; /* 1 if objProc was registered by a call to * Tcl_CreateObjCommand; 0 otherwise. @@ -870,7 +957,6 @@ typedef struct Tcl_CmdInfo { * field that clients should use is the string field, accessible via the * macro Tcl_DStringValue. */ - #define TCL_DSTRING_STATIC_SIZE 200 typedef struct Tcl_DString { char *string; /* Points to beginning of string: either @@ -893,7 +979,6 @@ typedef struct Tcl_DString { * be specified in the "tcl_precision" variable, and the number of * bytes of buffer space required by Tcl_PrintDouble. */ - #define TCL_MAX_PREC 17 #define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10) @@ -902,7 +987,6 @@ typedef struct Tcl_DString { * string representation of an integer in base 10 (assuming the existence * of 64-bit integers). */ - #define TCL_INTEGER_SPACE 24 /* @@ -910,14 +994,12 @@ typedef struct Tcl_DString { * output braces (careful! if you change this flag be sure to change * the definitions at the front of tclUtil.c). */ - #define TCL_DONT_USE_BRACES 1 /* * Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow * abbreviated strings. */ - #define TCL_EXACT 1 /* @@ -925,7 +1007,6 @@ typedef struct Tcl_DString { * WARNING: these bit choices must not conflict with the bit choices * for evalFlag bits in tclInt.h!! */ - #define TCL_NO_EVAL 0x10000 #define TCL_EVAL_GLOBAL 0x20000 #define TCL_EVAL_DIRECT 0x40000 @@ -934,7 +1015,6 @@ typedef struct Tcl_DString { * Special freeProc values that may be passed to Tcl_SetResult (see * the man page for details): */ - #define TCL_VOLATILE ((Tcl_FreeProc *) 1) #define TCL_STATIC ((Tcl_FreeProc *) 0) #define TCL_DYNAMIC ((Tcl_FreeProc *) 3) @@ -942,7 +1022,6 @@ typedef struct Tcl_DString { /* * Flag values passed to variable-related procedures. */ - #define TCL_GLOBAL_ONLY 1 #define TCL_NAMESPACE_ONLY 2 #define TCL_APPEND_VALUE 4 @@ -979,28 +1058,28 @@ typedef struct Tcl_DString { * flag) */ #ifndef TCL_NO_DEPRECATED -#define TCL_PARSE_PART1 0x400 +# define TCL_PARSE_PART1 0x400 #endif /* * Types for linked variables: */ - #define TCL_LINK_INT 1 #define TCL_LINK_DOUBLE 2 #define TCL_LINK_BOOLEAN 3 #define TCL_LINK_STRING 4 +#define TCL_LINK_WIDE_INT 5 #define TCL_LINK_READ_ONLY 0x80 + /* * Forward declarations of Tcl_HashTable and related types. */ - typedef struct Tcl_HashKeyType Tcl_HashKeyType; typedef struct Tcl_HashTable Tcl_HashTable; typedef struct Tcl_HashEntry Tcl_HashEntry; - + typedef unsigned int (Tcl_HashKeyProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr, VOID *keyPtr)); typedef int (Tcl_CompareHashKeysProc) _ANSI_ARGS_((VOID *keyPtr, @@ -1017,7 +1096,7 @@ typedef void (Tcl_FreeHashEntryProc) _ANSI_ARGS_((Tcl_HashEntry *hPtr)); * member has been removed and the space used to store the hash value. */ #ifndef TCL_HASH_KEY_STORE_HASH -#define TCL_HASH_KEY_STORE_HASH 1 +# define TCL_HASH_KEY_STORE_HASH 1 #endif /* @@ -1072,7 +1151,7 @@ struct Tcl_HashEntry { * N bits as the index into the table. */ #define TCL_HASH_KEY_RANDOMIZE_HASH 0x1 - + /* * Structure definition for the methods associated with a hash table * key type. @@ -1086,7 +1165,7 @@ struct Tcl_HashKeyType { */ int flags; /* Flags, see above for details. */ - + /* Calculates a hash value for the key. If this is NULL then the pointer * itself is used as a hash value. */ @@ -1115,7 +1194,7 @@ struct Tcl_HashKeyType { */ Tcl_FreeHashEntryProc *freeEntryProc; }; - + /* * Structure definition for a hash table. Must be in tcl.h so clients * can allocate space for these structures, but clients should never @@ -1232,21 +1311,19 @@ typedef struct Tcl_HashSearch { (*((tablePtr)->findProc))(tablePtr, key) # define Tcl_CreateHashEntry(tablePtr, key, newPtr) \ (*((tablePtr)->createProc))(tablePtr, key, newPtr) -#endif - -#if !TCL_PRESERVE_BINARY_COMPATABILITY +#else /* !TCL_PRESERVE_BINARY_COMPATABILITY */ /* * Macro to use new extended version of Tcl_InitHashTable. */ -#define Tcl_InitHashTable(tablePtr, keyType) \ +# define Tcl_InitHashTable(tablePtr, keyType) \ Tcl_InitHashTableEx(tablePtr, keyType, NULL) -#endif +#endif /* TCL_PRESERVE_BINARY_COMPATABILITY */ + /* * Flag values to pass to Tcl_DoOneEvent to disable searches * for some kinds of events: */ - #define TCL_DONT_WAIT (1<<1) #define TCL_WINDOW_EVENTS (1<<2) #define TCL_FILE_EVENTS (1<<3) @@ -1263,7 +1340,6 @@ typedef struct Tcl_HashSearch { * a Tcl_Event header followed by additional information specific to that * event. */ - struct Tcl_Event { Tcl_EventProc *proc; /* Procedure to call to service this event. */ struct Tcl_Event *nextPtr; /* Next in list of pending events, or NULL. */ @@ -1272,7 +1348,6 @@ struct Tcl_Event { /* * Positions to pass to Tcl_QueueEvent: */ - typedef enum { TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK } Tcl_QueuePosition; @@ -1281,17 +1356,16 @@ typedef enum { * Values to pass to Tcl_SetServiceMode to specify the behavior of notifier * event routines. */ - #define TCL_SERVICE_NONE 0 #define TCL_SERVICE_ALL 1 + /* * The following structure keeps is used to hold a time value, either as * an absolute time (the number of seconds from the epoch) or as an * elapsed time. On Unix systems the epoch is Midnight Jan 1, 1970 GMT. * On Macintosh systems the epoch is Midnight Jan 1, 1904 GMT. */ - typedef struct Tcl_Time { long sec; /* Seconds. */ long usec; /* Microseconds. */ @@ -1300,11 +1374,11 @@ typedef struct Tcl_Time { typedef void (Tcl_SetTimerProc) _ANSI_ARGS_((Tcl_Time *timePtr)); typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr)); + /* * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler * to indicate what sorts of events are of interest: */ - #define TCL_READABLE (1<<1) #define TCL_WRITABLE (1<<2) #define TCL_EXCEPTION (1<<3) @@ -1314,7 +1388,6 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr)); * disposition of the stdio handles. TCL_STDIN, TCL_STDOUT, TCL_STDERR, * are also used in Tcl_GetStdChannel. */ - #define TCL_STDIN (1<<1) #define TCL_STDOUT (1<<2) #define TCL_STDERR (1<<3) @@ -1324,7 +1397,6 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr)); * Bits passed to Tcl_DriverClose2Proc to indicate which side of a channel * should be closed. */ - #define TCL_CLOSE_READ (1<<1) #define TCL_CLOSE_WRITE (1<<2) @@ -1332,20 +1404,18 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr)); * Value to use as the closeProc for a channel that supports the * close2Proc interface. */ - #define TCL_CLOSE2PROC ((Tcl_DriverCloseProc *)1) /* * Channel version tag. This was introduced in 8.3.2/8.4. */ - #define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1) #define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2) + /* * Typedefs for the various operations in a channel type: */ - typedef int (Tcl_DriverBlockModeProc) _ANSI_ARGS_(( ClientData instanceData, int mode)); typedef int (Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData, @@ -1356,8 +1426,8 @@ typedef int (Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData, char *buf, int toRead, int *errorCodePtr)); typedef int (Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData, CONST84 char *buf, int toWrite, int *errorCodePtr)); -typedef int (Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData, - long offset, int mode, int *errorCodePtr)); +typedef Tcl_WideInt (Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData, + Tcl_WideInt offset, int mode, int *errorCodePtr)); typedef int (Tcl_DriverSetOptionProc) _ANSI_ARGS_(( ClientData instanceData, Tcl_Interp *interp, CONST char *optionName, CONST char *value)); @@ -1374,12 +1444,12 @@ typedef int (Tcl_DriverFlushProc) _ANSI_ARGS_(( typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_(( ClientData instanceData, int interestMask)); + /* * The following declarations either map ckalloc and ckfree to * malloc and free, or they map them to procedures with all sorts * of debugging hooks defined in tclCkalloc.c. */ - #ifdef TCL_MEM_DEBUG # define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__) @@ -1395,7 +1465,6 @@ typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_(( * is using the same memory allocator both inside and outside of the * Tcl library. */ - # define ckalloc(x) Tcl_Alloc(x) # define ckfree(x) Tcl_Free(x) # define ckrealloc(x,y) Tcl_Realloc(x,y) @@ -1417,7 +1486,6 @@ typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_(( * It is recommend that the Tcl_Channel* functions are used to access * elements of this structure, instead of direct accessing. */ - typedef struct Tcl_ChannelType { char *typeName; /* The name of the channel type in Tcl * commands. This storage is owned by @@ -1464,7 +1532,6 @@ typedef struct Tcl_ChannelType { * set the channel into blocking or nonblocking mode. They are passed * as arguments to the blockModeProc procedure in the above structure. */ - #define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */ #define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking * mode. */ @@ -1472,13 +1539,13 @@ typedef struct Tcl_ChannelType { /* * Enum for different types of file paths. */ - typedef enum Tcl_PathType { TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, TCL_PATH_VOLUME_RELATIVE } Tcl_PathType; + /* * The following structure is used to pass glob type data amongst * the various glob routines and Tcl_FSMatchInDirectory. @@ -1511,11 +1578,11 @@ typedef struct Tcl_GlobTypeData { #define TCL_GLOB_PERM_W (1<<3) #define TCL_GLOB_PERM_X (1<<4) + /* * Typedefs for the various filesystem operations: */ - -typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf)); +typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)); typedef int (Tcl_FSAccessProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode)); typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, @@ -1526,7 +1593,7 @@ typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp* interp, typedef Tcl_Obj* (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp *interp)); typedef int (Tcl_FSChdirProc) _ANSI_ARGS_((Tcl_Obj *pathPtr)); typedef int (Tcl_FSLstatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, - struct stat *buf)); + Tcl_StatBuf *buf)); typedef int (Tcl_FSCreateDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr)); typedef int (Tcl_FSDeleteFileProc) _ANSI_ARGS_((Tcl_Obj *pathPtr)); typedef int (Tcl_FSCopyDirectoryProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr, @@ -1586,7 +1653,6 @@ typedef struct Tcl_FSVersion_ *Tcl_FSVersion; /* * Filesystem version tag. This was introduced in 8.4. */ - #define TCL_FILESYSTEM_VERSION_1 ((Tcl_FSVersion) 0x1) /* @@ -1774,11 +1840,11 @@ typedef struct Tcl_Filesystem { */ } Tcl_Filesystem; + /* * The following structure represents the Notifier functions that * you can override with the Tcl_SetNotifier call. */ - typedef struct Tcl_NotifierProcs { Tcl_SetTimerProc *setTimerProc; Tcl_WaitForEventProc *waitForEventProc; @@ -1786,11 +1852,11 @@ typedef struct Tcl_NotifierProcs { Tcl_DeleteFileHandlerProc *deleteFileHandlerProc; } Tcl_NotifierProcs; + /* * The following structure represents a user-defined encoding. It collects * together all the functions that are used by the specific encoding. */ - typedef struct Tcl_EncodingType { CONST char *encodingName; /* The name of the encoding, e.g. "euc-jp". * This name is the unique key for this @@ -1844,16 +1910,14 @@ typedef struct Tcl_EncodingType { * in the destination buffer and then continue * to sonvert the source. */ - #define TCL_ENCODING_START 0x01 #define TCL_ENCODING_END 0x02 #define TCL_ENCODING_STOPONERROR 0x04 + /* - *---------------------------------------------------------------- - * The following data structures and declarations are for the new - * Tcl parser. This stuff should all move to tcl.h eventually. - *---------------------------------------------------------------- + * The following data structures and declarations are for the new Tcl + * parser. */ /* @@ -1861,7 +1925,6 @@ typedef struct Tcl_EncodingType { * variable reference, one of the following structures is created to * describe the token. */ - typedef struct Tcl_Token { int type; /* Type of token, such as TCL_TOKEN_WORD; * see below for valid types. */ @@ -1947,7 +2010,6 @@ typedef struct Tcl_Token { * operator's operands. NumComponents is * always 0. */ - #define TCL_TOKEN_WORD 1 #define TCL_TOKEN_SIMPLE_WORD 2 #define TCL_TOKEN_TEXT 4 @@ -1962,7 +2024,6 @@ typedef struct Tcl_Token { * will be stored in the error field of the Tcl_Parse structure * defined below. */ - #define TCL_PARSE_SUCCESS 0 #define TCL_PARSE_QUOTE_EXTRA 1 #define TCL_PARSE_BRACE_EXTRA 2 @@ -1978,7 +2039,6 @@ typedef struct Tcl_Token { * A structure of the following type is filled in by Tcl_ParseCommand. * It describes a single command parsed from an input string. */ - #define NUM_STATIC_TOKENS 20 typedef struct Tcl_Parse { @@ -2068,41 +2128,40 @@ typedef struct Tcl_Parse { * encoding. This error is reported only if * TCL_ENCODING_STOPONERROR was specified. */ - #define TCL_CONVERT_MULTIBYTE -1 #define TCL_CONVERT_SYNTAX -2 #define TCL_CONVERT_UNKNOWN -3 #define TCL_CONVERT_NOSPACE -4 + /* * The maximum number of bytes that are necessary to represent a single * Unicode character in UTF-8. */ - #define TCL_UTF_MAX 3 /* * This represents a Unicode character. Any changes to this should * also be reflected in regcustom.h. */ - typedef unsigned short Tcl_UniChar; + /* * Deprecated Tcl procedures: */ - #ifndef TCL_NO_DEPRECATED -#define Tcl_EvalObj(interp,objPtr) Tcl_EvalObjEx((interp),(objPtr),0) -#define Tcl_GlobalEvalObj(interp,objPtr) \ +# define Tcl_EvalObj(interp,objPtr) \ + Tcl_EvalObjEx((interp),(objPtr),0) +# define Tcl_GlobalEvalObj(interp,objPtr) \ Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) #endif + /* * These function have been renamed. The old names are deprecated, but we * define these macros for backwards compatibilty. */ - #define Tcl_Ckalloc Tcl_Alloc #define Tcl_Ckfree Tcl_Free #define Tcl_Ckrealloc Tcl_Realloc @@ -2111,6 +2170,7 @@ typedef unsigned short Tcl_UniChar; #define panic Tcl_Panic #define panicVA Tcl_PanicVA + /* * The following constant is used to test for older versions of Tcl * in the stubs tables. @@ -2183,7 +2243,6 @@ EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv, * This function is not *implemented* by the tcl library, so the storage * class is neither DLLEXPORT nor DLLIMPORT */ - #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS @@ -2197,9 +2256,8 @@ EXTERN int Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp)); /* * end block for C++ */ - #ifdef __cplusplus } #endif - + #endif /* _TCL */ diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d9765a0..814b4a5 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.46 2002/02/10 20:36:34 kennykb Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.47 2002/02/15 14:28:48 dkf Exp $ */ #include "tclInt.h" @@ -541,6 +541,9 @@ Tcl_CreateInterp() ((order.c[0] == 1) ? "littleEndian" : "bigEndian"), TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize", + Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY); + /* * Set up other variables such as tcl_version and tcl_library */ diff --git a/generic/tclBinary.c b/generic/tclBinary.c index f2d9327..c8ff568 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -10,12 +10,12 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBinary.c,v 1.11 2002/01/17 04:37:33 dgp Exp $ + * RCS: @(#) $Id: tclBinary.c,v 1.12 2002/02/15 14:28:48 dkf Exp $ */ -#include <math.h> #include "tclInt.h" #include "tclPort.h" +#include <math.h> /* * The following constants are used by GetFormatSpec to indicate various @@ -665,6 +665,11 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv) size = 4; goto doNumbers; } + case 'w': + case 'W': { + size = 8; + goto doNumbers; + } case 'f': { size = sizeof(float); goto doNumbers; @@ -945,6 +950,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv) case 'S': case 'i': case 'I': + case 'w': + case 'W': case 'd': case 'f': { int listc, i; @@ -1222,6 +1229,11 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv) size = 4; goto scanNumber; } + case 'w': + case 'W': { + size = 8; + goto scanNumber; + } case 'f': { size = sizeof(float); goto scanNumber; @@ -1455,8 +1467,11 @@ FormatNumber(interp, type, src, cursorPtr) { long value; double dvalue; + Tcl_WideInt wvalue; - if ((type == 'd') || (type == 'f')) { + switch (type) { + case 'd': + case 'f': /* * For floating point types, we need to copy the data using * memcpy to avoid alignment issues. @@ -1485,7 +1500,38 @@ FormatNumber(interp, type, src, cursorPtr) memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float)); *cursorPtr += sizeof(float); } - } else { + return TCL_OK; + + /* + * Next cases separate from other integer cases because we + * need a different API to get a wide. + */ + case 'w': + case 'W': + if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) { + return TCL_ERROR; + } + if (type == 'w') { + *(*cursorPtr)++ = (unsigned char) wvalue; + *(*cursorPtr)++ = (unsigned char) (wvalue >> 8); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 16); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 24); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 32); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 40); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 48); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 56); + } else { + *(*cursorPtr)++ = (unsigned char) (wvalue >> 56); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 48); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 40); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 32); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 24); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 16); + *(*cursorPtr)++ = (unsigned char) (wvalue >> 8); + *(*cursorPtr)++ = (unsigned char) wvalue; + } + return TCL_OK; + default: if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) { return TCL_ERROR; } @@ -1508,8 +1554,8 @@ FormatNumber(interp, type, src, cursorPtr) *(*cursorPtr)++ = (unsigned char) (value >> 8); *(*cursorPtr)++ = (unsigned char) value; } + return TCL_OK; } - return TCL_OK; } /* @@ -1542,6 +1588,7 @@ ScanNumber(buffer, type, numberCachePtrPtr) * different numbers have been scanned. */ { long value; + Tcl_WideInt wvalue; /* * We cannot rely on the compiler to properly sign extend integer values @@ -1630,7 +1677,26 @@ ScanNumber(buffer, type, numberCachePtrPtr) return objPtr; } } - + case 'w': + value = (long) (buffer[4] + | (buffer[5] << 8) + | (buffer[6] << 16) + | (buffer[7] << 24)); + wvalue = ((Tcl_WideInt) value) << 32 | (buffer[0] + | (buffer[1] << 8) + | (buffer[2] << 16) + | (buffer[3] << 24)); + return Tcl_NewWideIntObj(wvalue); + case 'W': + value = (long) (buffer[3] + | (buffer[2] << 8) + | (buffer[1] << 16) + | (buffer[0] << 24)); + wvalue = ((Tcl_WideInt) value) << 32 | (buffer[7] + | (buffer[6] << 8) + | (buffer[5] << 16) + | (buffer[4] << 24)); + return Tcl_NewWideIntObj(wvalue); case 'f': { float fvalue; memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float)); diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 6771374..d6c3ba7 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdAH.c,v 1.20 2002/01/26 01:10:08 dgp Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.21 2002/02/15 14:28:48 dkf Exp $ */ #include "tclInt.h" @@ -26,10 +26,10 @@ static int CheckAccess _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, int mode)); static int GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_FSStatProc *statProc, - struct stat *statPtr)); + Tcl_StatBuf *statPtr)); static char * GetTypeFromMode _ANSI_ARGS_((int mode)); static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp, - char *varName, struct stat *statPtr)); + char *varName, Tcl_StatBuf *statPtr)); /* *---------------------------------------------------------------------- @@ -93,9 +93,8 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { register int i; - int body, result; + int body, result, caseObjc; char *string, *arg; - int caseObjc; Tcl_Obj *CONST *caseObjv; Tcl_Obj *armPtr; @@ -725,6 +724,7 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv) * Create a new object holding the concatenated argument strings. */ + /*** QUESTION: Do we need to copy the slow way? ***/ bytes = Tcl_GetStringFromObj(objv[1], &length); objPtr = Tcl_NewStringObj(bytes, length); Tcl_IncrRefCount(objPtr); @@ -824,7 +824,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) switch ((enum options) index) { case FILE_ATIME: { - struct stat buf; + Tcl_StatBuf buf; struct utimbuf tval; if ((objc < 3) || (objc > 4)) { @@ -918,7 +918,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } case FILE_ISDIRECTORY: { int value; - struct stat buf; + Tcl_StatBuf buf; if (objc != 3) { goto only3Args; @@ -932,7 +932,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } case FILE_ISFILE: { int value; - struct stat buf; + Tcl_StatBuf buf; if (objc != 3) { goto only3Args; @@ -957,7 +957,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } case FILE_LSTAT: { char *varName; - struct stat buf; + Tcl_StatBuf buf; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "name varName"); @@ -970,7 +970,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return StoreStatData(interp, varName, &buf); } case FILE_MTIME: { - struct stat buf; + Tcl_StatBuf buf; struct utimbuf tval; if ((objc < 3) || (objc > 4)) { @@ -1045,7 +1045,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } case FILE_OWNED: { int value; - struct stat buf; + Tcl_StatBuf buf; if (objc != 3) { goto only3Args; @@ -1165,7 +1165,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_OK; } case FILE_SIZE: { - struct stat buf; + Tcl_StatBuf buf; if (objc != 3) { goto only3Args; @@ -1173,7 +1173,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } - Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_size); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), buf.st_size); return TCL_OK; } case FILE_SPLIT: { @@ -1185,7 +1185,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } case FILE_STAT: { char *varName; - struct stat buf; + Tcl_StatBuf buf; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "stat name varName"); @@ -1254,7 +1254,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_OK; } case FILE_TYPE: { - struct stat buf; + Tcl_StatBuf buf; if (objc != 3) { goto only3Args; @@ -1351,7 +1351,7 @@ GetStatBuf(interp, objPtr, statProc, statPtr) Tcl_Obj *objPtr; /* Path name to examine. */ Tcl_FSStatProc *statProc; /* Either stat() or lstat() depending on * desired behavior. */ - struct stat *statPtr; /* Filled with info about file obtained by + Tcl_StatBuf *statPtr; /* Filled with info about file obtained by * calling (*statProc)(). */ { int status; @@ -1397,66 +1397,50 @@ StoreStatData(interp, varName, statPtr) Tcl_Interp *interp; /* Interpreter for error reports. */ char *varName; /* Name of associative array variable * in which to store stat results. */ - struct stat *statPtr; /* Pointer to buffer containing + Tcl_StatBuf *statPtr; /* Pointer to buffer containing * stat data to store in varName. */ { - char string[TCL_INTEGER_SPACE]; + Tcl_Obj *var = Tcl_NewStringObj(varName, -1); + Tcl_Obj *field = Tcl_NewObj(); + Tcl_Obj *value; + register unsigned short mode; - TclFormatInt(string, (long) statPtr->st_dev); - if (Tcl_SetVar2(interp, varName, "dev", string, TCL_LEAVE_ERR_MSG) - == NULL) { - return TCL_ERROR; - } - TclFormatInt(string, (long) statPtr->st_ino); - if (Tcl_SetVar2(interp, varName, "ino", string, TCL_LEAVE_ERR_MSG) - == NULL) { - return TCL_ERROR; - } - TclFormatInt(string, (unsigned short) statPtr->st_mode); - if (Tcl_SetVar2(interp, varName, "mode", string, TCL_LEAVE_ERR_MSG) - == NULL) { - return TCL_ERROR; - } - TclFormatInt(string, (long) statPtr->st_nlink); - if (Tcl_SetVar2(interp, varName, "nlink", string, TCL_LEAVE_ERR_MSG) - == NULL) { - return TCL_ERROR; - } - TclFormatInt(string, (long) statPtr->st_uid); - if (Tcl_SetVar2(interp, varName, "uid", string, TCL_LEAVE_ERR_MSG) - == NULL) { - return TCL_ERROR; - } - TclFormatInt(string, (long) statPtr->st_gid); - if (Tcl_SetVar2(interp, varName, "gid", string, TCL_LEAVE_ERR_MSG) - == NULL) { - return TCL_ERROR; - } - sprintf(string, "%lu", (unsigned long) statPtr->st_size); - if (Tcl_SetVar2(interp, varName, "size", string, TCL_LEAVE_ERR_MSG) - == NULL) { - return TCL_ERROR; - } - TclFormatInt(string, (long) statPtr->st_atime); - if (Tcl_SetVar2(interp, varName, "atime", string, TCL_LEAVE_ERR_MSG) - == NULL) { - return TCL_ERROR; - } - TclFormatInt(string, (long) statPtr->st_mtime); - if (Tcl_SetVar2(interp, varName, "mtime", string, TCL_LEAVE_ERR_MSG) - == NULL) { - return TCL_ERROR; - } - TclFormatInt(string, (long) statPtr->st_ctime); - if (Tcl_SetVar2(interp, varName, "ctime", string, TCL_LEAVE_ERR_MSG) - == NULL) { - return TCL_ERROR; - } - if (Tcl_SetVar2(interp, varName, "type", - GetTypeFromMode((unsigned short) statPtr->st_mode), - TCL_LEAVE_ERR_MSG) == NULL) { - return TCL_ERROR; - } + /* + * Assume Tcl_ObjSetVar2() does not keep a copy of the field name! + */ +#define STORE_ARY(fieldName, object) \ + Tcl_SetStringObj(field, (fieldName), -1); \ + value = (object); \ + if (Tcl_ObjSetVar2(interp,var,field,value,TCL_LEAVE_ERR_MSG) == NULL) { \ + Tcl_DecrRefCount(var); \ + Tcl_DecrRefCount(field); \ + Tcl_DecrRefCount(value); \ + return TCL_ERROR; \ + } + + Tcl_IncrRefCount(var); + Tcl_IncrRefCount(field); + STORE_ARY("dev", Tcl_NewLongObj((long)statPtr->st_dev)); + /* + * Watch out porters; the inode is meant to be an *unsigned* value, + * so the cast might fail when there isn't a real arithmentic 'long + * long' type... + */ + STORE_ARY("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino)); + STORE_ARY("nlink", Tcl_NewLongObj((long)statPtr->st_nlink)); + STORE_ARY("uid", Tcl_NewLongObj((long)statPtr->st_uid)); + STORE_ARY("gid", Tcl_NewLongObj((long)statPtr->st_gid)); + STORE_ARY("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size)); +#ifdef HAVE_ST_BLOCKS + STORE_ARY("blocks",Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks)); +#endif + STORE_ARY("atime", Tcl_NewLongObj((long)statPtr->st_atime)); + STORE_ARY("mtime", Tcl_NewLongObj((long)statPtr->st_mtime)); + STORE_ARY("ctime", Tcl_NewLongObj((long)statPtr->st_ctime)); + mode = (unsigned short) statPtr->st_mode; + STORE_ARY("mode", Tcl_NewIntObj(mode)); + STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1)); +#undef STORE_ARY return TCL_OK; } @@ -1635,17 +1619,17 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) Tcl_Obj **argObjv = argObjStorage; #define STATIC_LIST_SIZE 4 - int indexArray[STATIC_LIST_SIZE]; /* Array of value list indices */ - int varcListArray[STATIC_LIST_SIZE]; /* # loop variables per list */ - Tcl_Obj **varvListArray[STATIC_LIST_SIZE]; /* Array of var name lists */ - int argcListArray[STATIC_LIST_SIZE]; /* Array of value list sizes */ - Tcl_Obj **argvListArray[STATIC_LIST_SIZE]; /* Array of value lists */ - - int *index = indexArray; - int *varcList = varcListArray; - Tcl_Obj ***varvList = varvListArray; - int *argcList = argcListArray; - Tcl_Obj ***argvList = argvListArray; + int indexArray[STATIC_LIST_SIZE]; + int varcListArray[STATIC_LIST_SIZE]; + Tcl_Obj **varvListArray[STATIC_LIST_SIZE]; + int argcListArray[STATIC_LIST_SIZE]; + Tcl_Obj **argvListArray[STATIC_LIST_SIZE]; + + int *index = indexArray; /* Array of value list indices */ + int *varcList = varcListArray; /* # loop variables per list */ + Tcl_Obj ***varvList = varvListArray; /* Array of var name lists */ + int *argcList = argcListArray; /* Array of value list sizes */ + Tcl_Obj ***argvList = argvListArray; /* Array of value lists */ if (objc < 4 || (objc%2 != 0)) { Tcl_WrongNumArgs(interp, 1, objv, @@ -1844,9 +1828,9 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) { char *format; /* Used to read characters from the format * string. */ - int formatLen; /* The length of the format string */ + int formatLen; /* The length of the format string */ char *endPtr; /* Points to the last char in format array */ - char newFormat[40]; /* A new format specifier is generated here. */ + char newFormat[43]; /* A new format specifier is generated here. */ int width; /* Field width from field specifier, or 0 if * no width given. */ int precision; /* Field precision from field specifier, or 0 @@ -1860,6 +1844,10 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) * it's a one-word value. */ double doubleValue; /* Used to hold value to pass to sprintf if * it's a double value. */ +#ifndef TCL_WIDE_INT_IS_LONG + Tcl_WideInt wideValue; /* Used to hold value to pass to sprintf if + * it's a 'long long' value. */ +#endif /* TCL_WIDE_INT_IS_LONG */ int whichValue; /* Indicates which of intValue, ptrValue, * or doubleValue has the value to pass to * sprintf, according to the following @@ -1869,6 +1857,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) # define PTR_VALUE 2 # define DOUBLE_VALUE 3 # define STRING_VALUE 4 +# define WIDE_VALUE 5 # define MAX_FLOAT_SIZE 320 Tcl_Obj *resultPtr; /* Where result is stored finally. */ @@ -1897,6 +1886,9 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) * been set for the current field. */ int gotZero; /* Non-zero indicates that a zero flag has * been seen in the current field. */ +#ifndef TCL_WIDE_INT_IS_LONG + int useWide; /* Value to be printed is Tcl_WideInt. */ +#endif /* TCL_WIDE_INT_IS_LONG */ /* * This procedure is a bit nasty. The goal is to use sprintf to @@ -1926,6 +1918,9 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) width = precision = noPercent = useShort = 0; gotZero = gotMinus = gotPrecision = 0; +#ifndef TCL_WIDE_INT_IS_LONG + useWide = 0; +#endif /* TCL_WIDE_INT_IS_LONG */ whichValue = PTR_VALUE; /* @@ -2069,6 +2064,11 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) } } if (*format == 'l') { +#ifndef TCL_WIDE_INT_IS_LONG + useWide = 1; + strcpy(newPtr, TCL_LL_MODIFIER); + newPtr += TCL_LL_MODIFIER_SIZE; +#endif /* TCL_WIDE_INT_IS_LONG */ format++; } else if (*format == 'h') { useShort = 1; @@ -2090,7 +2090,18 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) case 'u': case 'x': case 'X': - if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */ +#ifndef TCL_WIDE_INT_IS_LONG + if (useWide) { + if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */ + objv[objIndex], &wideValue) != TCL_OK) { + goto fmtError; + } + whichValue = WIDE_VALUE; + size = 40 + precision; + break; + } +#endif /* TCL_WIDE_INT_IS_LONG */ + if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &intValue) != TCL_OK) { goto fmtError; } @@ -2187,6 +2198,12 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */ break; } +#ifndef TCL_WIDE_INT_IS_LONG + case WIDE_VALUE: { + sprintf(dst, newFormat, wideValue); + break; + } +#endif /* TCL_WIDE_INT_IS_LONG */ case INT_VALUE: { if (useShort) { sprintf(dst, newFormat, (short) intValue); diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 4a922fe..f7cdf29 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.40 2002/01/26 01:10:08 dgp Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.41 2002/02/15 14:28:48 dkf Exp $ */ #include "tclInt.h" @@ -323,10 +323,36 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv) if (objc == 2) { incrAmount = 1; } else { +#ifdef TCL_WIDE_INT_IS_LONG if (Tcl_GetLongFromObj(interp, objv[2], &incrAmount) != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (reading increment)"); return TCL_ERROR; } +#else + /* + * Need to be a bit cautious to ensure that [expr]-like rules + * are enforced for interpretation of wide integers, despite + * the fact that the underlying API itself is a 'long' only one. + */ + if (objv[2]->typePtr == &tclIntType) { + incrAmount = objv[2]->internalRep.longValue; + } else if (objv[2]->typePtr == &tclWideIntType) { + incrAmount = Tcl_WideAsLong(objv[2]->internalRep.wideValue); + } else { + Tcl_WideInt wide; + + if (Tcl_GetWideIntFromObj(interp, objv[2], &wide) != TCL_OK) { + Tcl_AddErrorInfo(interp, "\n (reading increment)"); + return TCL_ERROR; + } + incrAmount = Tcl_WideAsLong(wide); + if ((wide <= Tcl_LongAsWide(LONG_MAX)) + && (wide >= Tcl_LongAsWide(LONG_MIN))) { + objv[2]->typePtr = &tclIntType; + objv[2]->internalRep.longValue = incrAmount; + } + } +#endif } /* diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 204f1ae..af2e214 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.59 2002/02/08 02:52:54 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.60 2002/02/15 14:28:48 dkf Exp $ */ #include "tclInt.h" @@ -1572,7 +1572,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) */ if (TclLooksLikeInt(string1, length1)) { errno = 0; - strtoul(string1, &stop, 0); +#ifdef TCL_WIDE_INT_IS_LONG + strtoul(string1, &stop, 0); /* INTL: Tcl source. */ +#else + strtoull(string1, &stop, 0); /* INTL: Tcl source. */ +#endif if (stop == end) { if (errno == ERANGE) { result = 0; @@ -1626,7 +1630,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) */ result = 0; errno = 0; +#ifdef TCL_WIDE_INT_IS_LONG strtoul(string1, &stop, 0); /* INTL: Tcl source. */ +#else + strtoull(string1, &stop, 0); /* INTL: Tcl source. */ +#endif if (errno == ERANGE) { /* * if (errno == ERANGE), then it was an over/underflow diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 1a44da8..e0bf175 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.h,v 1.24 2002/01/25 20:40:55 dgp Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.25 2002/02/15 14:28:48 dkf Exp $ */ #ifndef _TCLCOMPILATION @@ -513,6 +513,7 @@ typedef struct ByteCode { #define INST_LIST_INDEX 80 #define INST_LIST_LENGTH 81 +/* Opcodes 82 to 87 */ #define INST_APPEND_SCALAR1 82 #define INST_APPEND_SCALAR4 83 #define INST_APPEND_ARRAY1 84 @@ -520,6 +521,7 @@ typedef struct ByteCode { #define INST_APPEND_ARRAY_STK 86 #define INST_APPEND_STK 87 +/* Opcodes 88 to 93 */ #define INST_LAPPEND_SCALAR1 88 #define INST_LAPPEND_SCALAR4 89 #define INST_LAPPEND_ARRAY1 90 @@ -611,8 +613,9 @@ extern InstructionDesc instructionTable[]; #define BUILTIN_FUNC_RAND 22 #define BUILTIN_FUNC_ROUND 23 #define BUILTIN_FUNC_SRAND 24 +#define BUILTIN_FUNC_WIDE 25 -#define LAST_BUILTIN_FUNC 24 +#define LAST_BUILTIN_FUNC 25 /* * Table describing the built-in math functions. Entries in this table are diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 563805d..316da70 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.82 2002/02/10 20:36:34 kennykb Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.83 2002/02/15 14:28:48 dkf Exp $ */ #ifndef _TCLDECLS @@ -174,7 +174,7 @@ EXTERN int Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj ** objPtrPtr)); /* 47 */ EXTERN int Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_Obj * listPtr, int * intPtr)); + Tcl_Obj * listPtr, int * lengthPtr)); /* 48 */ EXTERN int Tcl_ListObjReplace _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int first, int count, @@ -717,8 +717,8 @@ EXTERN int Tcl_ScanElement _ANSI_ARGS_((CONST char * str, EXTERN int Tcl_ScanCountedElement _ANSI_ARGS_((CONST char * str, int length, int * flagPtr)); /* 220 */ -EXTERN int Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan, int offset, - int mode)); +EXTERN int Tcl_SeekOld _ANSI_ARGS_((Tcl_Channel chan, + int offset, int mode)); /* 221 */ EXTERN int Tcl_ServiceAll _ANSI_ARGS_((void)); /* 222 */ @@ -796,7 +796,7 @@ EXTERN void Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp * interp, EXTERN int Tcl_StringMatch _ANSI_ARGS_((CONST char * str, CONST char * pattern)); /* 246 */ -EXTERN int Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan)); +EXTERN int Tcl_TellOld _ANSI_ARGS_((Tcl_Channel chan)); /* 247 */ EXTERN int Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, @@ -1415,7 +1415,7 @@ EXTERN int Tcl_FSMatchInDirectory _ANSI_ARGS_(( Tcl_Obj * pathPtr, CONST char * pattern, Tcl_GlobTypeData * types)); /* 446 */ -EXTERN Tcl_Obj* Tcl_FSLink _ANSI_ARGS_((Tcl_Obj * pathPtr, +EXTERN Tcl_Obj * Tcl_FSLink _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj * toPtr)); /* 447 */ EXTERN int Tcl_FSRemoveDirectory _ANSI_ARGS_((Tcl_Obj * pathPtr, @@ -1425,7 +1425,7 @@ EXTERN int Tcl_FSRenameFile _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 449 */ EXTERN int Tcl_FSLstat _ANSI_ARGS_((Tcl_Obj * pathPtr, - struct stat * buf)); + Tcl_StatBuf * buf)); /* 450 */ EXTERN int Tcl_FSUtime _ANSI_ARGS_((Tcl_Obj * pathPtr, struct utimbuf * tval)); @@ -1442,7 +1442,7 @@ EXTERN CONST char ** Tcl_FSFileAttrStrings _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 454 */ EXTERN int Tcl_FSStat _ANSI_ARGS_((Tcl_Obj * pathPtr, - struct stat * buf)); + Tcl_StatBuf * buf)); /* 455 */ EXTERN int Tcl_FSAccess _ANSI_ARGS_((Tcl_Obj * pathPtr, int mode)); @@ -1533,6 +1533,26 @@ EXTERN int Tcl_GetCommandInfoFromToken _ANSI_ARGS_(( EXTERN int Tcl_SetCommandInfoFromToken _ANSI_ARGS_(( Tcl_Command token, CONST Tcl_CmdInfo* infoPtr)); +/* 486 */ +EXTERN Tcl_Obj * Tcl_DbNewWideIntObj _ANSI_ARGS_(( + Tcl_WideInt wideValue, CONST char * file, + int line)); +/* 487 */ +EXTERN int Tcl_GetWideIntFromObj _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Obj * objPtr, + Tcl_WideInt * widePtr)); +/* 488 */ +EXTERN Tcl_Obj * Tcl_NewWideIntObj _ANSI_ARGS_((Tcl_WideInt wideValue)); +/* 489 */ +EXTERN void Tcl_SetWideIntObj _ANSI_ARGS_((Tcl_Obj * objPtr, + Tcl_WideInt wideValue)); +/* 490 */ +EXTERN Tcl_StatBuf * Tcl_AllocStatBuf _ANSI_ARGS_((void)); +/* 491 */ +EXTERN Tcl_WideInt Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan, + Tcl_WideInt offset, int mode)); +/* 492 */ +EXTERN Tcl_WideInt Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; @@ -1607,7 +1627,7 @@ typedef struct TclStubs { int (*tcl_ListObjAppendElement) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * objPtr)); /* 44 */ int (*tcl_ListObjGetElements) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * objcPtr, Tcl_Obj *** objvPtr)); /* 45 */ int (*tcl_ListObjIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj ** objPtrPtr)); /* 46 */ - int (*tcl_ListObjLength) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * intPtr)); /* 47 */ + int (*tcl_ListObjLength) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * lengthPtr)); /* 47 */ int (*tcl_ListObjReplace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[])); /* 48 */ Tcl_Obj * (*tcl_NewBooleanObj) _ANSI_ARGS_((int boolValue)); /* 49 */ Tcl_Obj * (*tcl_NewByteArrayObj) _ANSI_ARGS_((CONST unsigned char* bytes, int length)); /* 50 */ @@ -1812,7 +1832,7 @@ typedef struct TclStubs { void (*tcl_ResetResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 217 */ int (*tcl_ScanElement) _ANSI_ARGS_((CONST char * str, int * flagPtr)); /* 218 */ int (*tcl_ScanCountedElement) _ANSI_ARGS_((CONST char * str, int length, int * flagPtr)); /* 219 */ - int (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, int offset, int mode)); /* 220 */ + int (*tcl_SeekOld) _ANSI_ARGS_((Tcl_Channel chan, int offset, int mode)); /* 220 */ int (*tcl_ServiceAll) _ANSI_ARGS_((void)); /* 221 */ int (*tcl_ServiceEvent) _ANSI_ARGS_((int flags)); /* 222 */ void (*tcl_SetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 223 */ @@ -1838,7 +1858,7 @@ typedef struct TclStubs { void (*tcl_SplitPath) _ANSI_ARGS_((CONST char * path, int * argcPtr, CONST84 char *** argvPtr)); /* 243 */ void (*tcl_StaticPackage) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pkgName, Tcl_PackageInitProc * initProc, Tcl_PackageInitProc * safeInitProc)); /* 244 */ int (*tcl_StringMatch) _ANSI_ARGS_((CONST char * str, CONST char * pattern)); /* 245 */ - int (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 246 */ + int (*tcl_TellOld) _ANSI_ARGS_((Tcl_Channel chan)); /* 246 */ int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 247 */ int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */ char * (*tcl_TranslateFileName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_DString * bufferPtr)); /* 249 */ @@ -2038,15 +2058,15 @@ typedef struct TclStubs { int (*tcl_FSDeleteFile) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 443 */ int (*tcl_FSLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * sym1, CONST char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr, Tcl_FSUnloadFileProc ** unloadProcPtr)); /* 444 */ int (*tcl_FSMatchInDirectory) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * result, Tcl_Obj * pathPtr, CONST char * pattern, Tcl_GlobTypeData * types)); /* 445 */ - Tcl_Obj* (*tcl_FSLink) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj * toPtr)); /* 446 */ + Tcl_Obj * (*tcl_FSLink) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj * toPtr)); /* 446 */ int (*tcl_FSRemoveDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)); /* 447 */ int (*tcl_FSRenameFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 448 */ - int (*tcl_FSLstat) _ANSI_ARGS_((Tcl_Obj * pathPtr, struct stat * buf)); /* 449 */ + int (*tcl_FSLstat) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_StatBuf * buf)); /* 449 */ int (*tcl_FSUtime) _ANSI_ARGS_((Tcl_Obj * pathPtr, struct utimbuf * tval)); /* 450 */ int (*tcl_FSFileAttrsGet) _ANSI_ARGS_((Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 451 */ int (*tcl_FSFileAttrsSet) _ANSI_ARGS_((Tcl_Interp * interp, int index, Tcl_Obj * pathPtr, Tcl_Obj * objPtr)); /* 452 */ CONST char ** (*tcl_FSFileAttrStrings) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 453 */ - int (*tcl_FSStat) _ANSI_ARGS_((Tcl_Obj * pathPtr, struct stat * buf)); /* 454 */ + int (*tcl_FSStat) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_StatBuf * buf)); /* 454 */ int (*tcl_FSAccess) _ANSI_ARGS_((Tcl_Obj * pathPtr, int mode)); /* 455 */ Tcl_Channel (*tcl_FSOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * modeString, int permissions)); /* 456 */ Tcl_Obj* (*tcl_FSGetCwd) _ANSI_ARGS_((Tcl_Interp * interp)); /* 457 */ @@ -2078,6 +2098,13 @@ typedef struct TclStubs { Tcl_Trace (*tcl_CreateObjTrace) _ANSI_ARGS_((Tcl_Interp* interp, int level, int flags, Tcl_CmdObjTraceProc* objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc* delProc)); /* 483 */ int (*tcl_GetCommandInfoFromToken) _ANSI_ARGS_((Tcl_Command token, Tcl_CmdInfo* infoPtr)); /* 484 */ int (*tcl_SetCommandInfoFromToken) _ANSI_ARGS_((Tcl_Command token, CONST Tcl_CmdInfo* infoPtr)); /* 485 */ + Tcl_Obj * (*tcl_DbNewWideIntObj) _ANSI_ARGS_((Tcl_WideInt wideValue, CONST char * file, int line)); /* 486 */ + int (*tcl_GetWideIntFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_WideInt * widePtr)); /* 487 */ + Tcl_Obj * (*tcl_NewWideIntObj) _ANSI_ARGS_((Tcl_WideInt wideValue)); /* 488 */ + void (*tcl_SetWideIntObj) _ANSI_ARGS_((Tcl_Obj * objPtr, Tcl_WideInt wideValue)); /* 489 */ + Tcl_StatBuf * (*tcl_AllocStatBuf) _ANSI_ARGS_((void)); /* 490 */ + Tcl_WideInt (*tcl_Seek) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt offset, int mode)); /* 491 */ + Tcl_WideInt (*tcl_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 492 */ } TclStubs; #ifdef __cplusplus @@ -3001,9 +3028,9 @@ extern TclStubs *tclStubsPtr; #define Tcl_ScanCountedElement \ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */ #endif -#ifndef Tcl_Seek -#define Tcl_Seek \ - (tclStubsPtr->tcl_Seek) /* 220 */ +#ifndef Tcl_SeekOld +#define Tcl_SeekOld \ + (tclStubsPtr->tcl_SeekOld) /* 220 */ #endif #ifndef Tcl_ServiceAll #define Tcl_ServiceAll \ @@ -3105,9 +3132,9 @@ extern TclStubs *tclStubsPtr; #define Tcl_StringMatch \ (tclStubsPtr->tcl_StringMatch) /* 245 */ #endif -#ifndef Tcl_Tell -#define Tcl_Tell \ - (tclStubsPtr->tcl_Tell) /* 246 */ +#ifndef Tcl_TellOld +#define Tcl_TellOld \ + (tclStubsPtr->tcl_TellOld) /* 246 */ #endif #ifndef Tcl_TraceVar #define Tcl_TraceVar \ @@ -4062,6 +4089,34 @@ extern TclStubs *tclStubsPtr; #define Tcl_SetCommandInfoFromToken \ (tclStubsPtr->tcl_SetCommandInfoFromToken) /* 485 */ #endif +#ifndef Tcl_DbNewWideIntObj +#define Tcl_DbNewWideIntObj \ + (tclStubsPtr->tcl_DbNewWideIntObj) /* 486 */ +#endif +#ifndef Tcl_GetWideIntFromObj +#define Tcl_GetWideIntFromObj \ + (tclStubsPtr->tcl_GetWideIntFromObj) /* 487 */ +#endif +#ifndef Tcl_NewWideIntObj +#define Tcl_NewWideIntObj \ + (tclStubsPtr->tcl_NewWideIntObj) /* 488 */ +#endif +#ifndef Tcl_SetWideIntObj +#define Tcl_SetWideIntObj \ + (tclStubsPtr->tcl_SetWideIntObj) /* 489 */ +#endif +#ifndef Tcl_AllocStatBuf +#define Tcl_AllocStatBuf \ + (tclStubsPtr->tcl_AllocStatBuf) /* 490 */ +#endif +#ifndef Tcl_Seek +#define Tcl_Seek \ + (tclStubsPtr->tcl_Seek) /* 491 */ +#endif +#ifndef Tcl_Tell +#define Tcl_Tell \ + (tclStubsPtr->tcl_Tell) /* 492 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index fbbaa53..546f000 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.46 2002/01/29 02:21:47 hobbs Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.47 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -210,13 +210,102 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; fprintf(stdout, "\n"); \ } #define O2S(objPtr) \ - (objPtr ? Tcl_GetString(objPtr) : "") + (objPtr ? TclGetString(objPtr) : "") #else #define TRACE(a) #define TRACE_WITH_OBJ(a, objPtr) #define O2S(objPtr) #endif /* TCL_COMPILE_DEBUG */ + +/* + * Most of the code to support working with wide values is factored + * out here because it greatly reduces the number of conditionals + * through the rest of the file. Note that this needs to be + * conditional because we do not want to alter Tcl's behaviour on + * native-64bit platforms... + */ + +#ifndef TCL_WIDE_INT_IS_LONG +#define W0 Tcl_LongAsWide(0) + +/* + * Macro to read a string containing either a wide or an int and + * decide which it is while decoding it at the same time. This + * enforces the policy that integer constants between LONG_MIN and + * LONG_MAX (inclusive) are represented by normal longs, and integer + * constants outside that range are represented by wide ints. + * + * GET_WIDE_OR_INT is the same as REQUIRE_WIDE_OR_INT except it never + * generates an error message. + */ +#define REQUIRE_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \ + (resultVar) = Tcl_GetWideIntFromObj(interp, (objPtr), &(wideVar)); \ + if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN) \ + && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) { \ + (objPtr)->typePtr = &tclIntType; \ + (objPtr)->internalRep.longValue = (longVar) \ + = Tcl_WideAsLong(wideVar); \ + } +#define GET_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \ + (resultVar) = Tcl_GetWideIntFromObj((Tcl_Interp *) NULL, (objPtr), \ + &(wideVar)); \ + if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN) \ + && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) { \ + (objPtr)->typePtr = &tclIntType; \ + (objPtr)->internalRep.longValue = (longVar) \ + = Tcl_WideAsLong(wideVar); \ + } +#define IS_INTEGER_TYPE(typePtr) \ + ((typePtr) == &tclIntType || (typePtr) == &tclWideIntType) +/* + * Extract a double value from a general numeric object. + */ +#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr) \ + if ((typePtr) == &tclIntType) { \ + (doubleVar) = (double) (objPtr)->internalRep.longValue; \ + } else if ((typePtr) == &tclWideIntType) { \ + (doubleVar) = Tcl_WideAsDouble((objPtr)->internalRep.wideValue);\ + } else { \ + (doubleVar) = (objPtr)->internalRep.doubleValue; \ + } +/* + * Combined with REQUIRE_WIDE_OR_INT, this gets a long value from + * an obj. + */ +#define FORCE_LONG(objPtr, longVar, wideVar) \ + if ((objPtr)->typePtr == &tclWideIntType) { \ + (longVar) = Tcl_WideAsLong(wideVar); \ + } +/* + * For tracing that uses wide values. + */ +#define LLTRACE(a) TRACE(a) +#define LLTRACE_WITH_OBJ(a,b) TRACE_WITH_OBJ(a,b) +#define LLD "%" TCL_LL_MODIFIER "d" +#else /* TCL_WIDE_INT_IS_LONG */ +/* + * Versions of the above that do not use wide values. + */ +#define REQUIRE_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \ + (resultVar) = Tcl_GetLongFromObj(interp, (objPtr), &(longVar)); +#define GET_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \ + (resultVar) = Tcl_GetLongFromObj((Tcl_Interp *) NULL, (objPtr), \ + &(longVar)); +#define IS_INTEGER_TYPE(typePtr) ((typePtr) == &tclIntType) +#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr) \ + if ((typePtr) == &tclIntType) { \ + (doubleVar) = (double) (objPtr)->internalRep.longValue; \ + } else { \ + (doubleVar) = (objPtr)->internalRep.doubleValue; \ + } +#define FORCE_LONG(objPtr, longVar, wideVar) +#define LLTRACE(a) +#define LLTRACE_WITH_OBJ(a,b) +#endif /* TCL_WIDE_INT_IS_LONG */ +#define IS_NUMERIC_TYPE(typePtr) \ + (IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType) + /* * Declarations for local procedures to this file: */ @@ -241,6 +330,10 @@ static int ExprSrandFunc _ANSI_ARGS_((Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)); static int ExprUnaryFunc _ANSI_ARGS_((Tcl_Interp *interp, ExecEnv *eePtr, ClientData clientData)); +#ifndef TCL_WIDE_INT_IS_LONG +static int ExprWideFunc _ANSI_ARGS_((Tcl_Interp *interp, + ExecEnv *eePtr, ClientData clientData)); +#endif #ifdef TCL_COMPILE_STATS static int EvalStatsCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); @@ -307,6 +400,11 @@ BuiltinFunc builtinFuncTable[] = { {"rand", 0, {TCL_EITHER}, ExprRandFunc, 0}, /* NOTE: rand takes no args. */ {"round", 1, {TCL_EITHER}, ExprRoundFunc, 0}, {"srand", 1, {TCL_INT}, ExprSrandFunc, 0}, +#ifdef TCL_WIDE_INT_IS_LONG + {"wide", 1, {TCL_EITHER}, ExprIntFunc, 0}, +#else + {"wide", 1, {TCL_EITHER}, ExprWideFunc, 0}, +#endif /* TCL_WIDE_INT_IS_LONG */ {0}, }; @@ -700,7 +798,7 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr) Tcl_SetObjResult(interp, saveObjPtr); } - Tcl_DecrRefCount(saveObjPtr); + TclDecrRefCount(saveObjPtr); return result; } @@ -995,7 +1093,10 @@ TclExecuteByteCode(interp, codePtr) Tcl_Obj *valuePtr, *value2Ptr, *objPtr, *elemPtr; char *bytes; int length; - long i; + long i = 0; /* Init. avoids compiler warning. */ +#ifndef TCL_WIDE_INT_IS_LONG + Tcl_WideInt w; +#endif /* * This procedure uses a stack to hold information about catch commands. @@ -1157,7 +1258,7 @@ TclExecuteByteCode(interp, codePtr) *p = '\0'; } else { for (i = (stackTop - (opnd-1)); i <= stackTop; i++) { - Tcl_DecrRefCount(stackPtr[i]); + TclDecrRefCount(stackPtr[i]); } } stackTop -= opnd; @@ -1193,7 +1294,7 @@ TclExecuteByteCode(interp, codePtr) #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { if (traceInstructions) { - strncpy(cmdNameBuf, Tcl_GetString(objv[0]), 20); + strncpy(cmdNameBuf, TclGetString(objv[0]), 20); TRACE(("%u => call ", objc)); } else { fprintf(stdout, "%d: (%u) invoking ", @@ -1399,7 +1500,7 @@ TclExecuteByteCode(interp, codePtr) if (rangePtr == NULL) { TRACE(("\"%.30s\" => no encl. loop or catch, returning %s\n", O2S(objPtr), StringForResultCode(result))); - Tcl_DecrRefCount(objPtr); + TclDecrRefCount(objPtr); goto abnormalReturn; /* no catch exists to check */ } switch (rangePtr->type) { @@ -1409,7 +1510,7 @@ TclExecuteByteCode(interp, codePtr) } else if (rangePtr->continueOffset == -1) { TRACE(("\"%.30s\" => %s, loop w/o continue, checking for catch\n", O2S(objPtr), StringForResultCode(result))); - Tcl_DecrRefCount(objPtr); + TclDecrRefCount(objPtr); goto checkForCatch; } else { newPcOffset = rangePtr->continueOffset; @@ -1422,18 +1523,18 @@ TclExecuteByteCode(interp, codePtr) case CATCH_EXCEPTION_RANGE: TRACE(("\"%.30s\" => %s ", O2S(objPtr), StringForResultCode(result))); - Tcl_DecrRefCount(objPtr); + TclDecrRefCount(objPtr); goto processCatch; /* it will use rangePtr */ default: panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type); } - Tcl_DecrRefCount(objPtr); + TclDecrRefCount(objPtr); pc = (codePtr->codeStart + newPcOffset); continue; /* restart outer instruction loop at pc */ } else { /* eval returned TCL_ERROR, TCL_RETURN, unknown code */ TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(objPtr); + TclDecrRefCount(objPtr); goto checkForCatch; } @@ -1446,7 +1547,7 @@ TclExecuteByteCode(interp, codePtr) if (result != TCL_OK) { TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(objPtr); + TclDecrRefCount(objPtr); goto checkForCatch; } stackPtr[++stackTop] = valuePtr; /* already has right refct */ @@ -1493,7 +1594,7 @@ TclExecuteByteCode(interp, codePtr) if (valuePtr == NULL) { TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(objPtr); + TclDecrRefCount(objPtr); result = TCL_ERROR; goto checkForCatch; } @@ -1521,7 +1622,7 @@ TclExecuteByteCode(interp, codePtr) if (valuePtr == NULL) { TRACE_WITH_OBJ(("%u \"%.30s\" => ERROR: ", opnd, O2S(elemPtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(elemPtr); + TclDecrRefCount(elemPtr); result = TCL_ERROR; goto checkForCatch; } @@ -1542,8 +1643,8 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("\"%.30s(%.30s)\" => ERROR: ", O2S(objPtr), O2S(elemPtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(elemPtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(elemPtr); result = TCL_ERROR; goto checkForCatch; } @@ -1572,7 +1673,7 @@ TclExecuteByteCode(interp, codePtr) if (value2Ptr == NULL) { TRACE_WITH_OBJ(("%u <- \"%.30s\" => ERROR: ", opnd, O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } @@ -1594,8 +1695,8 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ERROR: ", O2S(objPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } @@ -1626,8 +1727,8 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("%u \"%.30s\" <- \"%.30s\" => ERROR: ", opnd, O2S(elemPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(elemPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(elemPtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } @@ -1650,9 +1751,9 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ", O2S(objPtr), O2S(elemPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(elemPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(elemPtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } @@ -1687,7 +1788,7 @@ TclExecuteByteCode(interp, codePtr) if (value2Ptr == NULL) { TRACE_WITH_OBJ(("%u <- \"%.30s\" => ERROR: ", opnd, O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } @@ -1722,8 +1823,8 @@ TclExecuteByteCode(interp, codePtr) O2S(objPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); } - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } @@ -1761,8 +1862,8 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("%u \"%.30s\" <-+ \"%.30s\" => ERROR: ", opnd, O2S(elemPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(elemPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(elemPtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } @@ -1816,7 +1917,7 @@ TclExecuteByteCode(interp, codePtr) if (value2Ptr == NULL) { TRACE_WITH_OBJ(("%u <- \"%.30s\" => ERROR: ", opnd, O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } @@ -1855,7 +1956,7 @@ TclExecuteByteCode(interp, codePtr) TCL_TRACE_READS); CACHE_STACK_INFO(); if (valuePtr == NULL) { - valuePtr = Tcl_NewObj(); + TclNewObj(valuePtr); createdNewObj = 1; } else if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); @@ -1870,15 +1971,17 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ", O2S(objPtr), O2S(elemPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(elemPtr); + TclDecrRefCount(elemPtr); } else { TRACE_WITH_OBJ(("\"%.30s\" <-+ \"%.30s\" => ERROR: ", O2S(objPtr), O2S(value2Ptr)), Tcl_GetObjResult(interp)); } - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(value2Ptr); - if (createdNewObj) Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(value2Ptr); + if (createdNewObj) { + TclDecrRefCount(valuePtr); + } result = TCL_ERROR; goto checkForCatch; } @@ -1892,15 +1995,17 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ", O2S(objPtr), O2S(elemPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(elemPtr); + TclDecrRefCount(elemPtr); } else { TRACE_WITH_OBJ(("\"%.30s\" <-+ \"%.30s\" => ERROR: ", O2S(objPtr), O2S(value2Ptr)), Tcl_GetObjResult(interp)); } - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(value2Ptr); - if (createdNewObj) Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(value2Ptr); + if (createdNewObj) { + TclDecrRefCount(valuePtr); + } result = TCL_ERROR; goto checkForCatch; } @@ -1940,8 +2045,8 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("%u \"%.30s\" <-+ \"%.30s\" => ERROR: ", opnd, O2S(elemPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(elemPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(elemPtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } @@ -1958,24 +2063,30 @@ TclExecuteByteCode(interp, codePtr) case INST_INCR_SCALAR1: opnd = TclGetUInt1AtPtr(pc+1); - valuePtr = POP_OBJECT(); - if (valuePtr->typePtr != &tclIntType) { - result = tclIntType.setFromAnyProc(interp, valuePtr); + valuePtr = POP_OBJECT(); + if (valuePtr->typePtr == &tclIntType) { + i = valuePtr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + i = Tcl_WideAsLong(valuePtr->internalRep.wideValue); +#endif /* TCL_WIDE_INT_IS_LONG */ + } else { + REQUIRE_WIDE_OR_INT(result, valuePtr, i, w); if (result != TCL_OK) { TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ", opnd, O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); goto checkForCatch; } + FORCE_LONG(valuePtr, i, w); } - i = valuePtr->internalRep.longValue; DECACHE_STACK_INFO(); value2Ptr = TclIncrIndexedScalar(interp, opnd, i); CACHE_STACK_INFO(); if (value2Ptr == NULL) { TRACE_WITH_OBJ(("%u (by %ld) => ERROR: ", opnd, i), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } @@ -1988,18 +2099,24 @@ TclExecuteByteCode(interp, codePtr) case INST_INCR_STK: valuePtr = POP_OBJECT(); objPtr = POP_OBJECT(); /* scalar name */ - if (valuePtr->typePtr != &tclIntType) { - result = tclIntType.setFromAnyProc(interp, valuePtr); + if (valuePtr->typePtr == &tclIntType) { + i = valuePtr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + i = Tcl_WideAsLong(valuePtr->internalRep.wideValue); +#endif /* TCL_WIDE_INT_IS_LONG */ + } else { + REQUIRE_WIDE_OR_INT(result, valuePtr, i, w); if (result != TCL_OK) { TRACE_WITH_OBJ(("\"%.30s\" (by %s) => ERROR converting increment amount to int: ", O2S(objPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(valuePtr); goto checkForCatch; } + FORCE_LONG(valuePtr, i, w); } - i = valuePtr->internalRep.longValue; DECACHE_STACK_INFO(); value2Ptr = TclIncrVar2(interp, objPtr, (Tcl_Obj *) NULL, i, TCL_LEAVE_ERR_MSG); @@ -2007,34 +2124,40 @@ TclExecuteByteCode(interp, codePtr) if (value2Ptr == NULL) { TRACE_WITH_OBJ(("\"%.30s\" (by %ld) => ERROR: ", O2S(objPtr), i), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } PUSH_OBJECT(value2Ptr); TRACE_WITH_OBJ(("\"%.30s\" (by %ld) => ", O2S(objPtr), i), value2Ptr); - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(valuePtr); ADJUST_PC(1); case INST_INCR_ARRAY1: opnd = TclGetUInt1AtPtr(pc+1); valuePtr = POP_OBJECT(); elemPtr = POP_OBJECT(); - if (valuePtr->typePtr != &tclIntType) { - result = tclIntType.setFromAnyProc(interp, valuePtr); + if (valuePtr->typePtr == &tclIntType) { + i = valuePtr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + i = Tcl_WideAsLong(valuePtr->internalRep.wideValue); +#endif /* TCL_WIDE_INT_IS_LONG */ + } else { + REQUIRE_WIDE_OR_INT(result, valuePtr, i, w); if (result != TCL_OK) { TRACE_WITH_OBJ(("%u \"%.30s\" (by %s) => ERROR converting increment amount to int: ", opnd, O2S(elemPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(elemPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(elemPtr); + TclDecrRefCount(valuePtr); goto checkForCatch; } + FORCE_LONG(valuePtr, i, w); } - i = valuePtr->internalRep.longValue; DECACHE_STACK_INFO(); value2Ptr = TclIncrElementOfIndexedArray(interp, opnd, elemPtr, i); @@ -2043,35 +2166,41 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ERROR: ", opnd, O2S(elemPtr), i), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(elemPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(elemPtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } PUSH_OBJECT(value2Ptr); TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ", opnd, O2S(elemPtr), i), value2Ptr); - Tcl_DecrRefCount(elemPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(elemPtr); + TclDecrRefCount(valuePtr); ADJUST_PC(2); case INST_INCR_ARRAY_STK: valuePtr = POP_OBJECT(); elemPtr = POP_OBJECT(); objPtr = POP_OBJECT(); /* array name */ - if (valuePtr->typePtr != &tclIntType) { - result = tclIntType.setFromAnyProc(interp, valuePtr); + if (valuePtr->typePtr == &tclIntType) { + i = valuePtr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + i = Tcl_WideAsLong(valuePtr->internalRep.wideValue); +#endif /* TCL_WIDE_INT_IS_LONG */ + } else { + REQUIRE_WIDE_OR_INT(result, valuePtr, i, w); if (result != TCL_OK) { TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %s) => ERROR converting increment amount to int: ", O2S(objPtr), O2S(elemPtr), O2S(valuePtr)), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(elemPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(elemPtr); + TclDecrRefCount(valuePtr); goto checkForCatch; } + FORCE_LONG(valuePtr, i, w); } - i = valuePtr->internalRep.longValue; DECACHE_STACK_INFO(); value2Ptr = TclIncrVar2(interp, objPtr, elemPtr, i, TCL_LEAVE_ERR_MSG); @@ -2080,18 +2209,18 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ERROR: ", O2S(objPtr), O2S(elemPtr), i), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(elemPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(elemPtr); + TclDecrRefCount(valuePtr); result = TCL_ERROR; goto checkForCatch; } PUSH_OBJECT(value2Ptr); TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ", O2S(objPtr), O2S(elemPtr), i), value2Ptr); - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(elemPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(elemPtr); + TclDecrRefCount(valuePtr); ADJUST_PC(1); case INST_INCR_SCALAR1_IMM: @@ -2122,7 +2251,7 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("\"%.30s\" %ld => ERROR: ", O2S(objPtr), i), Tcl_GetObjResult(interp)); result = TCL_ERROR; - Tcl_DecrRefCount(objPtr); + TclDecrRefCount(objPtr); goto checkForCatch; } PUSH_OBJECT(value2Ptr); @@ -2143,14 +2272,14 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ERROR: ", opnd, O2S(elemPtr), i), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(elemPtr); + TclDecrRefCount(elemPtr); result = TCL_ERROR; goto checkForCatch; } PUSH_OBJECT(value2Ptr); TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ", opnd, O2S(elemPtr), i), value2Ptr); - Tcl_DecrRefCount(elemPtr); + TclDecrRefCount(elemPtr); ADJUST_PC(3); case INST_INCR_ARRAY_STK_IMM: @@ -2165,18 +2294,22 @@ TclExecuteByteCode(interp, codePtr) TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ERROR: ", O2S(objPtr), O2S(elemPtr), i), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(elemPtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(elemPtr); result = TCL_ERROR; goto checkForCatch; } PUSH_OBJECT(value2Ptr); TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ", O2S(objPtr), O2S(elemPtr), i), value2Ptr); - Tcl_DecrRefCount(objPtr); - Tcl_DecrRefCount(elemPtr); + TclDecrRefCount(objPtr); + TclDecrRefCount(elemPtr); ADJUST_PC(2); + /* + * END INCR INSTRUCTIONS + */ + case INST_JUMP1: #ifdef TCL_COMPILE_DEBUG opnd = TclGetInt1AtPtr(pc+1); @@ -2212,12 +2345,16 @@ TclExecuteByteCode(interp, codePtr) b = (valuePtr->internalRep.longValue != 0); } else if (valuePtr->typePtr == &tclDoubleType) { b = (valuePtr->internalRep.doubleValue != 0.0); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + b = (valuePtr->internalRep.wideValue != W0); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { result = Tcl_GetBooleanFromObj(interp, valuePtr, &b); if (result != TCL_OK) { TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); goto checkForCatch; } } @@ -2252,12 +2389,16 @@ TclExecuteByteCode(interp, codePtr) b = (valuePtr->internalRep.longValue != 0); } else if (valuePtr->typePtr == &tclDoubleType) { b = (valuePtr->internalRep.doubleValue != 0.0); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + b = (valuePtr->internalRep.wideValue != W0); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { result = Tcl_GetBooleanFromObj(interp, valuePtr, &b); if (result != TCL_OK) { TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp)); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); goto checkForCatch; } } @@ -2294,14 +2435,27 @@ TclExecuteByteCode(interp, codePtr) if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) { i1 = (valuePtr->internalRep.longValue != 0); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (t1Ptr == &tclWideIntType) { + i1 = (valuePtr->internalRep.wideValue != W0); +#endif /* TCL_WIDE_INT_IS_LONG */ } else if (t1Ptr == &tclDoubleType) { i1 = (valuePtr->internalRep.doubleValue != 0.0); } else { s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { +#ifdef TCL_WIDE_INT_IS_LONG result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); i1 = (i != 0); +#else /* !TCL_WIDE_INT_IS_LONG */ + GET_WIDE_OR_INT(result, valuePtr, i, w); + if (valuePtr->typePtr == &tclIntType) { + i1 = (i != 0); + } else { + i1 = (w != W0); + } +#endif /* TCL_WIDE_INT_IS_LONG */ } else { result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, valuePtr, &i1); @@ -2312,22 +2466,35 @@ TclExecuteByteCode(interp, codePtr) O2S(valuePtr), (t1Ptr? t1Ptr->name : "null"))); IllegalExprOperandType(interp, pc, valuePtr); - Tcl_DecrRefCount(valuePtr); - Tcl_DecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); goto checkForCatch; } } if ((t2Ptr == &tclIntType) || (t2Ptr == &tclBooleanType)) { i2 = (value2Ptr->internalRep.longValue != 0); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (t2Ptr == &tclWideIntType) { + i2 = (value2Ptr->internalRep.wideValue != W0); +#endif /* TCL_WIDE_INT_IS_LONG */ } else if (t2Ptr == &tclDoubleType) { i2 = (value2Ptr->internalRep.doubleValue != 0.0); } else { s = Tcl_GetStringFromObj(value2Ptr, &length); if (TclLooksLikeInt(s, length)) { +#ifdef TCL_WIDE_INT_IS_LONG result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, value2Ptr, &i); i2 = (i != 0); +#else /* !TCL_WIDE_INT_IS_LONG */ + GET_WIDE_OR_INT(result, value2Ptr, i, w); + if (value2Ptr->typePtr == &tclIntType) { + i2 = (i != 0); + } else { + i2 = (w != W0); + } +#endif /* TCL_WIDE_INT_IS_LONG */ } else { result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, value2Ptr, &i2); @@ -2337,8 +2504,8 @@ TclExecuteByteCode(interp, codePtr) O2S(value2Ptr), (t2Ptr? t2Ptr->name : "null"))); IllegalExprOperandType(interp, pc, value2Ptr); - Tcl_DecrRefCount(valuePtr); - Tcl_DecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); goto checkForCatch; } } @@ -2383,42 +2550,38 @@ TclExecuteByteCode(interp, codePtr) ADJUST_PC(1); case INST_LIST_INDEX: - { - - /*** lindex with objc == 3 ***/ + /*** lindex with objc == 3 ***/ - /* Pop the two operands */ - - value2Ptr = POP_OBJECT(); - valuePtr = POP_OBJECT(); - - /* Extract the desired list element */ - - objPtr = TclLindexList( interp, valuePtr, value2Ptr ); - if ( objPtr == NULL ) { - TRACE_WITH_OBJ( ( "%.30s %.30s => ERROR: ", - O2S( valuePtr ), - O2S( value2Ptr ) ), - Tcl_GetObjResult( interp ) ); - TclDecrRefCount( value2Ptr ); - TclDecrRefCount( valuePtr ); - result = TCL_ERROR; - goto checkForCatch; - } - - /* Stash the list element on the stack */ + /* + * Pop the two operands + */ + value2Ptr = POP_OBJECT(); + valuePtr = POP_OBJECT(); - PUSH_OBJECT( objPtr ); - TRACE(( "%.20s %.20s => %s\n", - O2S( valuePtr ), - O2S( value2Ptr ), - O2S( objPtr ) ) ); - TclDecrRefCount( valuePtr ); - TclDecrRefCount( value2Ptr ); - TclDecrRefCount( objPtr ); + /* + * Extract the desired list element + */ + objPtr = TclLindexList(interp, valuePtr, value2Ptr); + if (objPtr == NULL) { + TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", + O2S(valuePtr), O2S(value2Ptr)), + Tcl_GetObjResult(interp)); + TclDecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + result = TCL_ERROR; + goto checkForCatch; } - ADJUST_PC( 1 ); + /* + * Stash the list element on the stack + */ + PUSH_OBJECT(objPtr); + TRACE(("%.20s %.20s => %s\n", + O2S(valuePtr), O2S(value2Ptr), O2S(objPtr))); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); + TclDecrRefCount(objPtr); + ADJUST_PC(1); case INST_LIST_INDEX_MULTI: { @@ -2427,7 +2590,7 @@ TclExecuteByteCode(interp, codePtr) * * Determine the count of index args. */ - + int numIdx; opnd = TclGetUInt4AtPtr(pc+1); @@ -2436,154 +2599,141 @@ TclExecuteByteCode(interp, codePtr) /* * Do the 'lindex' operation. */ + objPtr = TclLindexFlat(interp, stackPtr[stackTop - numIdx], + numIdx, stackPtr + stackTop - numIdx + 1); - objPtr = TclLindexFlat( interp, - stackPtr[ stackTop - numIdx ], - numIdx, - stackPtr + stackTop - numIdx + 1 ); /* * Clean up ref counts */ - - for ( i = 0 ; i <= numIdx ; i++ ) { - Tcl_DecrRefCount( stackPtr[ stackTop -- ] ); + for (i=0 ; i<=numIdx ; i++) { + /* + * Watch out for multiple references in macros! + */ + valuePtr = stackPtr[stackTop--]; + TclDecrRefCount(valuePtr); } /* * Check for errors */ - - if ( objPtr == NULL ) { - TRACE_WITH_OBJ( ( "%d => ERROR: ", opnd ), - Tcl_GetObjResult( interp ) ); + if (objPtr == NULL) { + TRACE_WITH_OBJ(("%d => ERROR: ", opnd), + Tcl_GetObjResult(interp)); result = TCL_ERROR; goto checkForCatch; } - + /* * Set result */ - - PUSH_OBJECT( objPtr ); - TRACE(( "%d => %s\n", opnd, O2S( objPtr ) )); - Tcl_DecrRefCount( objPtr ); - + PUSH_OBJECT(objPtr); + TRACE(("%d => %s\n", opnd, O2S(objPtr))); + TclDecrRefCount(objPtr); } - ADJUST_PC( 5 ); + ADJUST_PC(5); case INST_LSET_FLAT: { /* - * Lset with 3, 5, or more args. Get the number of index args. + * Lset with 3, 5, or more args. Get the number + * of index args. */ - int numIdx; opnd = TclGetUInt4AtPtr( pc + 1 ); numIdx = opnd - 2; - + /* * Get the old value of variable, and remove the stack ref. * This is safe because the variable still references the * object; the ref count will never go zero here. */ - value2Ptr = POP_OBJECT(); - Tcl_DecrRefCount( value2Ptr ); + TclDecrRefCount(value2Ptr); /* * Get the new element value. */ - valuePtr = POP_OBJECT(); /* * Compute the new variable value */ - - objPtr = TclLsetFlat( interp, value2Ptr, numIdx, - stackPtr + stackTop - numIdx + 1, - valuePtr ); - Tcl_DecrRefCount( valuePtr ); + objPtr = TclLsetFlat(interp, value2Ptr, numIdx, + stackPtr + stackTop - numIdx + 1, valuePtr); + TclDecrRefCount(valuePtr); /* * Clean up ref counts */ - - for ( i = 0 ; i < numIdx ; i++ ) { - Tcl_DecrRefCount( stackPtr[ stackTop -- ] ); + for (i=0 ; i<numIdx ; i++) { + /* + * Watch out for multiple references in macros! + */ + valuePtr = stackPtr[stackTop--]; + TclDecrRefCount(valuePtr); } /* * Check for errors */ - - if ( objPtr == NULL ) { - TRACE_WITH_OBJ( ( "%d => ERROR: ", opnd ), - Tcl_GetObjResult( interp ) ); + if (objPtr == NULL) { + TRACE_WITH_OBJ(("%d => ERROR: ", opnd), + Tcl_GetObjResult(interp)); result = TCL_ERROR; goto checkForCatch; } - + /* * Set result */ - - PUSH_OBJECT( objPtr ); - TRACE(( "%d => %s\n", opnd, O2S( objPtr ) )); - Tcl_DecrRefCount( objPtr ); - + PUSH_OBJECT(objPtr); + TRACE(("%d => %s\n", opnd, O2S(objPtr))); + TclDecrRefCount(objPtr); } - ADJUST_PC( 5 ); + ADJUST_PC(5); case INST_LSET_LIST: - { - /* - * 'lset' with 4 args. - * - * Get the old value of variable, and remove the stack ref. - * This is safe because the variable still references the - * object; the ref count will never go zero here. - */ - - objPtr = POP_OBJECT(); - Tcl_DecrRefCount( objPtr ); - - /* - * Get the new element value, and the index list - */ - - valuePtr = POP_OBJECT(); - value2Ptr = POP_OBJECT(); - - /* - * Compute the new variable value - */ - - objPtr = TclLsetList( interp, objPtr, value2Ptr, valuePtr ); - Tcl_DecrRefCount( valuePtr ); - Tcl_DecrRefCount( value2Ptr ); + /* + * 'lset' with 4 args. + * + * Get the old value of variable, and remove the stack ref. + * This is safe because the variable still references the + * object; the ref count will never go zero here. + */ + objPtr = POP_OBJECT(); + TclDecrRefCount(objPtr); - /* - * Check for errors - */ + /* + * Get the new element value, and the index list + */ + valuePtr = POP_OBJECT(); + value2Ptr = POP_OBJECT(); - if ( objPtr == NULL ) { - TRACE_WITH_OBJ( ( "\"%.30s\" => ERROR: ", O2S(value2Ptr)), - Tcl_GetObjResult( interp ) ); - result = TCL_ERROR; - goto checkForCatch; - } - - /* - * Set result - */ + /* + * Compute the new variable value + */ + objPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); - PUSH_OBJECT( objPtr ); - TRACE(( "=> %s\n", O2S( objPtr ) )); - Tcl_DecrRefCount( objPtr ); + /* + * Check for errors + */ + if (objPtr == NULL) { + TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)), + Tcl_GetObjResult(interp)); + result = TCL_ERROR; + goto checkForCatch; } - ADJUST_PC( 1 ); + + /* + * Set result + */ + PUSH_OBJECT(objPtr); + TRACE(("=> %s\n", O2S(objPtr))); + TclDecrRefCount(objPtr); + ADJUST_PC(1); case INST_STR_EQ: case INST_STR_NEQ: @@ -2752,8 +2902,8 @@ TclExecuteByteCode(interp, codePtr) result = TclGetIntForIndex(interp, value2Ptr, length - 1, &index); if (result != TCL_OK) { - Tcl_DecrRefCount(value2Ptr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); goto checkForCatch; } @@ -2776,7 +2926,7 @@ TclExecuteByteCode(interp, codePtr) objPtr = Tcl_NewStringObj(buf, length); } } else { - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); } PUSH_OBJECT(objPtr); @@ -2804,8 +2954,8 @@ TclExecuteByteCode(interp, codePtr) match = Tcl_UniCharCaseMatch(Tcl_GetUnicode(valuePtr), Tcl_GetUnicode(value2Ptr), nocase); } else { - match = Tcl_StringCaseMatch(Tcl_GetString(valuePtr), - Tcl_GetString(value2Ptr), nocase); + match = Tcl_StringCaseMatch(TclGetString(valuePtr), + TclGetString(value2Ptr), nocase); } /* @@ -2841,12 +2991,12 @@ TclExecuteByteCode(interp, codePtr) */ Tcl_ObjType *t1Ptr, *t2Ptr; - char *s1 = NULL; /* Init. avoids compiler warning. */ - char *s2 = NULL; /* Init. avoids compiler warning. */ - long i2 = 0; /* Init. avoids compiler warning. */ - double d1 = 0.0; /* Init. avoids compiler warning. */ - double d2 = 0.0; /* Init. avoids compiler warning. */ - long iResult = 0; /* Init. avoids compiler warning. */ + char *s1 = NULL; /* Init. avoids compiler warning. */ + char *s2 = NULL; /* Init. avoids compiler warning. */ + long i2 = 0; /* Init. avoids compiler warning. */ + double d1 = 0.0; /* Init. avoids compiler warning. */ + double d2 = 0.0; /* Init. avoids compiler warning. */ + long iResult = 0; /* Init. avoids compiler warning. */ value2Ptr = POP_OBJECT(); valuePtr = POP_OBJECT(); @@ -2858,26 +3008,24 @@ TclExecuteByteCode(interp, codePtr) * neither type is NULL. A NULL type means the arg is * essentially an empty object ("", {} or [list]). */ - if (!((((t1Ptr == NULL) && (valuePtr->bytes == NULL)) - || (valuePtr->bytes && (valuePtr->length == 0))) - || (((t2Ptr == NULL) && (value2Ptr->bytes == NULL)) - || (value2Ptr->bytes && (value2Ptr->length == 0))))) { - if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) { + if (!( (!t1Ptr && !valuePtr->bytes) + || (valuePtr->bytes && !valuePtr->length) + || (!t2Ptr && !value2Ptr->bytes) + || (value2Ptr->bytes && !value2Ptr->length))) { + if (!IS_NUMERIC_TYPE(t1Ptr)) { s1 = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s1, length)) { - (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL, - valuePtr, &i); + GET_WIDE_OR_INT(iResult, valuePtr, i, w); } else { (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d1); } t1Ptr = valuePtr->typePtr; } - if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) { + if (!IS_NUMERIC_TYPE(t2Ptr)) { s2 = Tcl_GetStringFromObj(value2Ptr, &length); if (TclLooksLikeInt(s2, length)) { - (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL, - value2Ptr, &i2); + GET_WIDE_OR_INT(iResult, value2Ptr, i2, w); } else { (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, value2Ptr, &d2); @@ -2885,15 +3033,14 @@ TclExecuteByteCode(interp, codePtr) t2Ptr = value2Ptr->typePtr; } } - if (((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) - || ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType))) { + if (!IS_NUMERIC_TYPE(t1Ptr) || !IS_NUMERIC_TYPE(t2Ptr)) { /* * One operand is not numeric. Compare as strings. * NOTE: strcmp is not correct for \x00 < \x01. */ int cmpValue; - s1 = Tcl_GetString(valuePtr); - s2 = Tcl_GetString(value2Ptr); + s1 = TclGetString(valuePtr); + s2 = TclGetString(value2Ptr); cmpValue = strcmp(s1, s2); switch (*pc) { case INST_EQ: @@ -2922,13 +3069,9 @@ TclExecuteByteCode(interp, codePtr) */ if (t1Ptr == &tclDoubleType) { d1 = valuePtr->internalRep.doubleValue; - if (t2Ptr == &tclIntType) { - d2 = value2Ptr->internalRep.longValue; - } else { - d2 = value2Ptr->internalRep.doubleValue; - } - } else { /* t1Ptr is int, t2Ptr is double */ - d1 = valuePtr->internalRep.longValue; + GET_DOUBLE_VALUE(d2, value2Ptr, t2Ptr); + } else { /* t1Ptr is integer, t2Ptr is double */ + GET_DOUBLE_VALUE(d1, valuePtr, t1Ptr); d2 = value2Ptr->internalRep.doubleValue; } switch (*pc) { @@ -2951,6 +3094,44 @@ TclExecuteByteCode(interp, codePtr) iResult = d1 >= d2; break; } +#ifndef TCL_WIDE_INT_IS_LONG + } else if ((t1Ptr == &tclWideIntType) + || (t2Ptr == &tclWideIntType)) { + Tcl_WideInt w2; + /* + * Compare as wide ints (neither are doubles) + */ + if (t1Ptr == &tclIntType) { + w = Tcl_LongAsWide(valuePtr->internalRep.longValue); + w2 = value2Ptr->internalRep.wideValue; + } else if (t2Ptr == &tclIntType) { + w = valuePtr->internalRep.wideValue; + w2 = Tcl_LongAsWide(value2Ptr->internalRep.longValue); + } else { + w = valuePtr->internalRep.wideValue; + w2 = value2Ptr->internalRep.wideValue; + } + switch (*pc) { + case INST_EQ: + iResult = w == w2; + break; + case INST_NEQ: + iResult = w != w2; + break; + case INST_LT: + iResult = w < w2; + break; + case INST_GT: + iResult = w > w2; + break; + case INST_LE: + iResult = w <= w2; + break; + case INST_GE: + iResult = w >= w2; + break; + } +#endif /* TCL_WIDE_INT_IS_LONG */ } else { /* * Compare as ints. @@ -2983,21 +3164,19 @@ TclExecuteByteCode(interp, codePtr) * Reuse the valuePtr object already on stack if possible. */ + TRACE(("%.20s %.20s => %ld\n", + O2S(valuePtr), O2S(value2Ptr), iResult)); if (Tcl_IsShared(valuePtr)) { PUSH_OBJECT(Tcl_NewLongObj(iResult)); - TRACE(("%.20s %.20s => %ld\n", - O2S(valuePtr), O2S(value2Ptr), iResult)); TclDecrRefCount(valuePtr); } else { /* reuse the valuePtr object */ - TRACE(("%.20s %.20s => %ld\n", - O2S(valuePtr), O2S(value2Ptr), iResult)); Tcl_SetLongObj(valuePtr, iResult); ++stackTop; /* valuePtr now on stk top has right r.c. */ } TclDecrRefCount(value2Ptr); } ADJUST_PC(1); - + case INST_MOD: case INST_LSHIFT: case INST_RSHIFT: @@ -3009,40 +3188,50 @@ TclExecuteByteCode(interp, codePtr) * Only integers are allowed. We compute value op value2. */ - long i2, rem, negative; + long i2 = 0, rem, negative; long iResult = 0; /* Init. avoids compiler warning. */ - +#ifndef TCL_WIDE_INT_IS_LONG + Tcl_WideInt w2, wResult = W0; + int doWide = 0; +#endif /* TCL_WIDE_INT_IS_LONG */ + value2Ptr = POP_OBJECT(); valuePtr = POP_OBJECT(); if (valuePtr->typePtr == &tclIntType) { i = valuePtr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + w = valuePtr->internalRep.wideValue; +#endif /* TCL_WIDE_INT_IS_LONG */ } else { /* try to convert to int */ - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, - valuePtr, &i); + REQUIRE_WIDE_OR_INT(result, valuePtr, i, w); if (result != TCL_OK) { TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); IllegalExprOperandType(interp, pc, valuePtr); - Tcl_DecrRefCount(valuePtr); - Tcl_DecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); goto checkForCatch; } } if (value2Ptr->typePtr == &tclIntType) { i2 = value2Ptr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (value2Ptr->typePtr == &tclWideIntType) { + w2 = value2Ptr->internalRep.wideValue; +#endif /* TCL_WIDE_INT_IS_LONG */ } else { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, - value2Ptr, &i2); + REQUIRE_WIDE_OR_INT(result, value2Ptr, i2, w2); if (result != TCL_OK) { TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); IllegalExprOperandType(interp, pc, value2Ptr); - Tcl_DecrRefCount(valuePtr); - Tcl_DecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); goto checkForCatch; } } @@ -3055,13 +3244,65 @@ TclExecuteByteCode(interp, codePtr) * remainder always has the same sign as the divisor and * a smaller absolute value. */ +#ifdef TCL_WIDE_INT_IS_LONG if (i2 == 0) { TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2)); - Tcl_DecrRefCount(valuePtr); - Tcl_DecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); + goto divideByZero; + } +#else /* !TCL_WIDE_INT_IS_LONG */ + if (value2Ptr->typePtr == &tclWideIntType && w2 == W0) { + if (valuePtr->typePtr == &tclIntType) { + LLTRACE(("%ld "LLD" => DIVIDE BY ZERO\n", i, w2)); + } else { + LLTRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2)); + } + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); goto divideByZero; } + if (value2Ptr->typePtr == &tclIntType && i2 == 0) { + if (valuePtr->typePtr == &tclIntType) { + TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2)); + } else { + LLTRACE((LLD" %ld => DIVIDE BY ZERO\n", w, i2)); + } + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); + goto divideByZero; + } +#endif /* TCL_WIDE_INT_IS_LONG */ negative = 0; +#ifndef TCL_WIDE_INT_IS_LONG + if (valuePtr->typePtr == &tclWideIntType + || value2Ptr->typePtr == &tclWideIntType) { + Tcl_WideInt wRemainder; + /* + * Promote to wide + */ + if (valuePtr->typePtr == &tclIntType) { + w = Tcl_LongAsWide(i); + } else if (value2Ptr->typePtr == &tclIntType) { + w2 = Tcl_LongAsWide(i2); + } + if (w2 < 0) { + w2 = -w2; + w = -w; + negative = 1; + } + wRemainder = w % w2; + if (wRemainder < 0) { + wRemainder += w2; + } + if (negative) { + wRemainder = -wRemainder; + } + wResult = wRemainder; + doWide = 1; + break; + } +#endif /* TCL_WIDE_INT_IS_LONG */ if (i2 < 0) { i2 = -i2; i = -i; @@ -3077,6 +3318,20 @@ TclExecuteByteCode(interp, codePtr) iResult = rem; break; case INST_LSHIFT: +#ifndef TCL_WIDE_INT_IS_LONG + /* + * Shifts are never usefully 64-bits wide! + */ + FORCE_LONG(value2Ptr, i2, w2); + if (valuePtr->typePtr == &tclWideIntType) { +#ifdef TCL_COMPILE_DEBUG + w2 = Tcl_LongAsWide(i2); +#endif /* TCL_COMPILE_DEBUG */ + wResult = w << i2; + doWide = 1; + break; + } +#endif /* TCL_WIDE_INT_IS_LONG */ iResult = i << i2; break; case INST_RSHIFT: @@ -3085,6 +3340,24 @@ TclExecuteByteCode(interp, codePtr) * right shifts propagate the sign bit even on machines * where ">>" won't do it by default. */ +#ifndef TCL_WIDE_INT_IS_LONG + /* + * Shifts are never usefully 64-bits wide! + */ + FORCE_LONG(value2Ptr, i2, w2); + if (valuePtr->typePtr == &tclWideIntType) { +#ifdef TCL_COMPILE_DEBUG + w2 = Tcl_LongAsWide(i2); +#endif /* TCL_COMPILE_DEBUG */ + if (w < 0) { + wResult = ~((~w) >> i2); + } else { + wResult = w >> i2; + } + doWide = 1; + break; + } +#endif /* TCL_WIDE_INT_IS_LONG */ if (i < 0) { iResult = ~((~i) >> i2); } else { @@ -3092,12 +3365,60 @@ TclExecuteByteCode(interp, codePtr) } break; case INST_BITOR: +#ifndef TCL_WIDE_INT_IS_LONG + if (valuePtr->typePtr == &tclWideIntType + || value2Ptr->typePtr == &tclWideIntType) { + /* + * Promote to wide + */ + if (valuePtr->typePtr == &tclIntType) { + w = Tcl_LongAsWide(i); + } else if (value2Ptr->typePtr == &tclIntType) { + w2 = Tcl_LongAsWide(i2); + } + wResult = w | w2; + doWide = 1; + break; + } +#endif /* TCL_WIDE_INT_IS_LONG */ iResult = i | i2; break; case INST_BITXOR: +#ifndef TCL_WIDE_INT_IS_LONG + if (valuePtr->typePtr == &tclWideIntType + || value2Ptr->typePtr == &tclWideIntType) { + /* + * Promote to wide + */ + if (valuePtr->typePtr == &tclIntType) { + w = Tcl_LongAsWide(i); + } else if (value2Ptr->typePtr == &tclIntType) { + w2 = Tcl_LongAsWide(i2); + } + wResult = w ^ w2; + doWide = 1; + break; + } +#endif /* TCL_WIDE_INT_IS_LONG */ iResult = i ^ i2; break; case INST_BITAND: +#ifndef TCL_WIDE_INT_IS_LONG + if (valuePtr->typePtr == &tclWideIntType + || value2Ptr->typePtr == &tclWideIntType) { + /* + * Promote to wide + */ + if (valuePtr->typePtr == &tclIntType) { + w = Tcl_LongAsWide(i); + } else if (value2Ptr->typePtr == &tclIntType) { + w2 = Tcl_LongAsWide(i2); + } + wResult = w & w2; + doWide = 1; + break; + } +#endif /* TCL_WIDE_INT_IS_LONG */ iResult = i & i2; break; } @@ -3107,18 +3428,36 @@ TclExecuteByteCode(interp, codePtr) */ if (Tcl_IsShared(valuePtr)) { - PUSH_OBJECT(Tcl_NewLongObj(iResult)); - TRACE(("%ld %ld => %ld\n", i, i2, iResult)); +#ifndef TCL_WIDE_INT_IS_LONG + if (doWide) { + PUSH_OBJECT(Tcl_NewWideIntObj(wResult)); + LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); + } else { +#endif /* TCL_WIDE_INT_IS_LONG */ + PUSH_OBJECT(Tcl_NewLongObj(iResult)); + TRACE(("%ld %ld => %ld\n", i, i2, iResult)); +#ifndef TCL_WIDE_INT_IS_LONG + } +#endif /* TCL_WIDE_INT_IS_LONG */ TclDecrRefCount(valuePtr); } else { /* reuse the valuePtr object */ - TRACE(("%ld %ld => %ld\n", i, i2, iResult)); - Tcl_SetLongObj(valuePtr, iResult); +#ifndef TCL_WIDE_INT_IS_LONG + if (doWide) { + LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); + Tcl_SetWideIntObj(valuePtr, wResult); + } else { +#endif /* TCL_WIDE_INT_IS_LONG */ + TRACE(("%ld %ld => %ld\n", i, i2, iResult)); + Tcl_SetLongObj(valuePtr, iResult); +#ifndef TCL_WIDE_INT_IS_LONG + } +#endif /* TCL_WIDE_INT_IS_LONG */ ++stackTop; /* valuePtr now on stk top has right r.c. */ } TclDecrRefCount(value2Ptr); } ADJUST_PC(1); - + case INST_ADD: case INST_SUB: case INST_MULT: @@ -3130,19 +3469,28 @@ TclExecuteByteCode(interp, codePtr) */ Tcl_ObjType *t1Ptr, *t2Ptr; - long i2, quot, rem; + long i2 = 0, quot, rem; /* Init. avoids compiler warning. */ double d1, d2; - long iResult = 0; /* Init. avoids compiler warning. */ - double dResult = 0.0; /* Init. avoids compiler warning. */ - int doDouble = 0; /* 1 if doing floating arithmetic */ - + long iResult = 0; /* Init. avoids compiler warning. */ + double dResult = 0.0; /* Init. avoids compiler warning. */ + int doDouble = 0; /* 1 if doing floating arithmetic */ +#ifndef TCL_WIDE_INT_IS_LONG + Tcl_WideInt w2, wquot, wrem; + Tcl_WideInt wResult = W0; /* Init. avoids compiler warning. */ + int doWide = 0; /* 1 if doing wide arithmetic. */ +#endif /* TCL_WIDE_INT_IS_LONG */ + value2Ptr = POP_OBJECT(); valuePtr = POP_OBJECT(); t1Ptr = valuePtr->typePtr; t2Ptr = value2Ptr->typePtr; if (t1Ptr == &tclIntType) { - i = valuePtr->internalRep.longValue; + i = valuePtr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (t1Ptr == &tclWideIntType) { + w = valuePtr->internalRep.wideValue; +#endif /* TCL_WIDE_INT_IS_LONG */ } else if ((t1Ptr == &tclDoubleType) && (valuePtr->bytes == NULL)) { /* @@ -3155,8 +3503,7 @@ TclExecuteByteCode(interp, codePtr) } else { char *s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, - valuePtr, &i); + GET_WIDE_OR_INT(result, valuePtr, i, w); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d1); @@ -3167,15 +3514,19 @@ TclExecuteByteCode(interp, codePtr) (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); IllegalExprOperandType(interp, pc, valuePtr); - Tcl_DecrRefCount(valuePtr); - Tcl_DecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); goto checkForCatch; } t1Ptr = valuePtr->typePtr; } - + if (t2Ptr == &tclIntType) { i2 = value2Ptr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (t2Ptr == &tclWideIntType) { + w2 = value2Ptr->internalRep.wideValue; +#endif /* TCL_WIDE_INT_IS_LONG */ } else if ((t2Ptr == &tclDoubleType) && (value2Ptr->bytes == NULL)) { /* @@ -3188,8 +3539,7 @@ TclExecuteByteCode(interp, codePtr) } else { char *s = Tcl_GetStringFromObj(value2Ptr, &length); if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, - value2Ptr, &i2); + GET_WIDE_OR_INT(result, value2Ptr, i2, w2); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, value2Ptr, &d2); @@ -3200,8 +3550,8 @@ TclExecuteByteCode(interp, codePtr) (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); IllegalExprOperandType(interp, pc, value2Ptr); - Tcl_DecrRefCount(valuePtr); - Tcl_DecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); goto checkForCatch; } t2Ptr = value2Ptr->typePtr; @@ -3216,6 +3566,12 @@ TclExecuteByteCode(interp, codePtr) d1 = i; /* promote value 1 to double */ } else if (t2Ptr == &tclIntType) { d2 = i2; /* promote value 2 to double */ +#ifndef TCL_WIDE_INT_IS_LONG + } else if (t1Ptr == &tclWideIntType) { + d1 = Tcl_WideAsDouble(w); + } else if (t2Ptr == &tclWideIntType) { + d2 = Tcl_WideAsDouble(w2); +#endif /* TCL_WIDE_INT_IS_LONG */ } switch (*pc) { case INST_ADD: @@ -3230,8 +3586,8 @@ TclExecuteByteCode(interp, codePtr) case INST_DIV: if (d2 == 0.0) { TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2)); - Tcl_DecrRefCount(valuePtr); - Tcl_DecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); goto divideByZero; } dResult = d1 / d2; @@ -3247,10 +3603,58 @@ TclExecuteByteCode(interp, codePtr) O2S(valuePtr), O2S(value2Ptr))); TclExprFloatError(interp, dResult); result = TCL_ERROR; - Tcl_DecrRefCount(valuePtr); - Tcl_DecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); goto checkForCatch; } +#ifndef TCL_WIDE_INT_IS_LONG + } else if ((t1Ptr == &tclWideIntType) || + (t2Ptr == &tclWideIntType)) { + /* + * Do wide integer arithmetic. + */ + doWide = 1; + if (t1Ptr == &tclIntType) { + w = Tcl_LongAsWide(i); + } else if (t2Ptr == &tclIntType) { + w2 = Tcl_LongAsWide(i2); + } + switch (*pc) { + case INST_ADD: + wResult = w + w2; + break; + case INST_SUB: + wResult = w - w2; + break; + case INST_MULT: + wResult = w * w2; + break; + case INST_DIV: + /* + * This code is tricky: C doesn't guarantee much + * about the quotient or remainder, but Tcl does. + * The remainder always has the same sign as the + * divisor and a smaller absolute value. + */ + if (w2 == W0) { + LLTRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2)); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); + goto divideByZero; + } + if (w2 < 0) { + w2 = -w2; + w = -w; + } + wquot = w / w2; + wrem = w % w2; + if (wrem < W0) { + wquot -= 1; + } + wResult = wquot; + break; + } +#endif /* TCL_WIDE_INT_IS_LONG */ } else { /* * Do integer arithmetic. @@ -3274,8 +3678,8 @@ TclExecuteByteCode(interp, codePtr) */ if (i2 == 0) { TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2)); - Tcl_DecrRefCount(valuePtr); - Tcl_DecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); goto divideByZero; } if (i2 < 0) { @@ -3300,6 +3704,11 @@ TclExecuteByteCode(interp, codePtr) if (doDouble) { PUSH_OBJECT(Tcl_NewDoubleObj(dResult)); TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult)); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (doWide) { + PUSH_OBJECT(Tcl_NewWideIntObj(wResult)); + LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { PUSH_OBJECT(Tcl_NewLongObj(iResult)); TRACE(("%ld %ld => %ld\n", i, i2, iResult)); @@ -3309,6 +3718,11 @@ TclExecuteByteCode(interp, codePtr) if (doDouble) { /* NB: stack top is off by 1 */ TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult)); Tcl_SetDoubleObj(valuePtr, dResult); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (doWide) { + LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult)); + Tcl_SetWideIntObj(valuePtr, wResult); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { TRACE(("%ld %ld => %ld\n", i, i2, iResult)); Tcl_SetLongObj(valuePtr, iResult); @@ -3318,7 +3732,7 @@ TclExecuteByteCode(interp, codePtr) TclDecrRefCount(value2Ptr); } ADJUST_PC(1); - + case INST_UPLUS: { /* @@ -3330,12 +3744,11 @@ TclExecuteByteCode(interp, codePtr) valuePtr = stackPtr[stackTop]; tPtr = valuePtr->typePtr; - if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType) + if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType) || (valuePtr->bytes != NULL))) { char *s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, - valuePtr, &i); + GET_WIDE_OR_INT(result, valuePtr, i, w); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); @@ -3362,12 +3775,17 @@ TclExecuteByteCode(interp, codePtr) if (tPtr == &tclIntType) { i = valuePtr->internalRep.longValue; objPtr = Tcl_NewLongObj(i); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (tPtr == &tclWideIntType) { + w = valuePtr->internalRep.wideValue; + objPtr = Tcl_NewWideIntObj(w); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; objPtr = Tcl_NewDoubleObj(d); } Tcl_IncrRefCount(objPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); valuePtr = objPtr; stackPtr[stackTop] = valuePtr; } else { @@ -3395,7 +3813,7 @@ TclExecuteByteCode(interp, codePtr) valuePtr = POP_OBJECT(); tPtr = valuePtr->typePtr; - if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType) + if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType) || (valuePtr->bytes != NULL))) { if ((tPtr == &tclBooleanType) && (valuePtr->bytes == NULL)) { @@ -3403,8 +3821,7 @@ TclExecuteByteCode(interp, codePtr) } else { char *s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, - valuePtr, &i); + GET_WIDE_OR_INT(result, valuePtr, i, w); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); @@ -3418,7 +3835,7 @@ TclExecuteByteCode(interp, codePtr) TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", s, (tPtr? tPtr->name : "null"))); IllegalExprOperandType(interp, pc, valuePtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); goto checkForCatch; } } @@ -3434,6 +3851,16 @@ TclExecuteByteCode(interp, codePtr) objPtr = Tcl_NewLongObj( (*pc == INST_UMINUS)? -i : !i); TRACE_WITH_OBJ(("%ld => ", i), objPtr); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (tPtr == &tclWideIntType) { + w = valuePtr->internalRep.wideValue; + if (*pc == INST_UMINUS) { + objPtr = Tcl_NewWideIntObj(-w); + } else { + objPtr = Tcl_NewLongObj(w == W0); + } + LLTRACE_WITH_OBJ((LLD" => ", w), objPtr); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; if (*pc == INST_UMINUS) { @@ -3458,6 +3885,16 @@ TclExecuteByteCode(interp, codePtr) Tcl_SetLongObj(valuePtr, (*pc == INST_UMINUS)? -i : !i); TRACE_WITH_OBJ(("%ld => ", i), valuePtr); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (tPtr == &tclWideIntType) { + w = valuePtr->internalRep.wideValue; + if (*pc == INST_UMINUS) { + Tcl_SetWideIntObj(valuePtr, -w); + } else { + Tcl_SetLongObj(valuePtr, w == W0); + } + LLTRACE_WITH_OBJ((LLD" => ", w), valuePtr); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; if (*pc == INST_UMINUS) { @@ -3475,7 +3912,7 @@ TclExecuteByteCode(interp, codePtr) } } ADJUST_PC(1); - + case INST_BITNOT: { /* @@ -3489,34 +3926,53 @@ TclExecuteByteCode(interp, codePtr) valuePtr = POP_OBJECT(); tPtr = valuePtr->typePtr; - if (tPtr != &tclIntType) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, - valuePtr, &i); + if (!IS_INTEGER_TYPE(tPtr)) { + REQUIRE_WIDE_OR_INT(result, valuePtr, i, w); if (result != TCL_OK) { /* try to convert to double */ TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr), (tPtr? tPtr->name : "null"))); IllegalExprOperandType(interp, pc, valuePtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); goto checkForCatch; } } - i = valuePtr->internalRep.longValue; - if (Tcl_IsShared(valuePtr)) { - PUSH_OBJECT(Tcl_NewLongObj(~i)); - TRACE(("0x%lx => (%lu)\n", i, ~i)); - TclDecrRefCount(valuePtr); +#ifndef TCL_WIDE_INT_IS_LONG + if (valuePtr->typePtr == &tclWideIntType) { + w = valuePtr->internalRep.wideValue; + if (Tcl_IsShared(valuePtr)) { + PUSH_OBJECT(Tcl_NewWideIntObj(~w)); + LLTRACE(("0x%llx => (%llu)\n", w, ~w)); + TclDecrRefCount(valuePtr); + } else { + /* + * valuePtr is unshared. Modify it directly. + */ + Tcl_SetWideIntObj(valuePtr, ~w); + ++stackTop; /*valuePtr now on stk top has right r.c.*/ + LLTRACE(("0x%llx => (%llu)\n", w, ~w)); + } } else { - /* - * valuePtr is unshared. Modify it directly. - */ - Tcl_SetLongObj(valuePtr, ~i); - ++stackTop; /* valuePtr now on stk top has right r.c. */ - TRACE(("0x%lx => (%lu)\n", i, ~i)); +#endif /* TCL_WIDE_INT_IS_LONG */ + i = valuePtr->internalRep.longValue; + if (Tcl_IsShared(valuePtr)) { + PUSH_OBJECT(Tcl_NewLongObj(~i)); + TRACE(("0x%lx => (%lu)\n", i, ~i)); + TclDecrRefCount(valuePtr); + } else { + /* + * valuePtr is unshared. Modify it directly. + */ + Tcl_SetLongObj(valuePtr, ~i); + ++stackTop; /*valuePtr now on stk top has right r.c.*/ + TRACE(("0x%lx => (%lu)\n", i, ~i)); + } +#ifndef TCL_WIDE_INT_IS_LONG } +#endif /* TCL_WIDE_INT_IS_LONG */ } ADJUST_PC(1); - + case INST_CALL_BUILTIN_FUNC1: opnd = TclGetUInt1AtPtr(pc+1); { @@ -3589,7 +4045,7 @@ TclExecuteByteCode(interp, codePtr) valuePtr = stackPtr[stackTop]; tPtr = valuePtr->typePtr; converted = 0; - if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType) + if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType) || (valuePtr->bytes != NULL))) { if ((tPtr == &tclBooleanType) && (valuePtr->bytes == NULL)) { @@ -3598,15 +4054,14 @@ TclExecuteByteCode(interp, codePtr) } else { s = Tcl_GetStringFromObj(valuePtr, &length); if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, - valuePtr, &i); + GET_WIDE_OR_INT(result, valuePtr, i, w); } else { result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); } if (result == TCL_OK) { converted = 1; - } + } result = TCL_OK; /* reset the result variable */ } tPtr = valuePtr->typePtr; @@ -3623,7 +4078,7 @@ TclExecuteByteCode(interp, codePtr) * floating point error. */ - if ((tPtr == &tclIntType) || (tPtr == &tclDoubleType)) { + if (IS_NUMERIC_TYPE(tPtr)) { shared = 0; if (Tcl_IsShared(valuePtr)) { shared = 1; @@ -3635,6 +4090,11 @@ TclExecuteByteCode(interp, codePtr) if (tPtr == &tclIntType) { i = valuePtr->internalRep.longValue; objPtr = Tcl_NewLongObj(i); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (tPtr == &tclWideIntType) { + w = valuePtr->internalRep.wideValue; + objPtr = Tcl_NewWideIntObj(w); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; objPtr = Tcl_NewDoubleObj(d); @@ -3844,7 +4304,7 @@ TclExecuteByteCode(interp, codePtr) int setEmptyStr = 0; if (valIndex >= listLen) { setEmptyStr = 1; - valuePtr = Tcl_NewObj(); + TclNewObj(valuePtr); } else { valuePtr = listRepPtr->elements[valIndex]; } @@ -3859,7 +4319,7 @@ TclExecuteByteCode(interp, codePtr) opnd, varIndex), Tcl_GetObjResult(interp)); if (setEmptyStr) { - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); } result = TCL_ERROR; goto checkForCatch; @@ -3985,7 +4445,7 @@ TclExecuteByteCode(interp, codePtr) abnormalReturn: while (stackTop > initStackTop) { valuePtr = POP_OBJECT(); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); } if (stackTop < initStackTop) { fprintf(stderr, "\nTclExecuteByteCode: abnormal return at pc %u: stack top %d < entry stack top %d\n", @@ -4185,7 +4645,7 @@ IllegalExprOperandType(interp, pc, opndPtr) * improve the error message. */ - char *s = Tcl_GetString(opndPtr); + char *s = TclGetString(opndPtr); double d; if (Tcl_GetDouble((Tcl_Interp *) NULL, s, &d) == TCL_OK) { @@ -4193,7 +4653,7 @@ IllegalExprOperandType(interp, pc, opndPtr) * Make sure that what appears to be a double * (ie 08) isn't really a bad octal */ - if (TclCheckBadOctal(NULL, Tcl_GetString(opndPtr))) { + if (TclCheckBadOctal(NULL, TclGetString(opndPtr))) { msg = "invalid octal number"; } else { msg = "floating-point value"; @@ -4439,7 +4899,8 @@ GetOpcodeName(pc) * TCL_OK if it was int or double, TCL_ERROR otherwise * * Side effects: - * objPtr is ensured to be either tclIntType of tclDoubleType. + * objPtr is ensured to be of tclIntType, tclWideIntType or + * tclDoubleType. * *---------------------------------------------------------------------- */ @@ -4450,16 +4911,20 @@ VerifyExprObjType(interp, objPtr) * function. */ Tcl_Obj *objPtr; /* Points to the object to type check. */ { - if ((objPtr->typePtr == &tclIntType) || - (objPtr->typePtr == &tclDoubleType)) { + if (IS_NUMERIC_TYPE(objPtr->typePtr)) { return TCL_OK; } else { int length, result = TCL_OK; char *s = Tcl_GetStringFromObj(objPtr, &length); if (TclLooksLikeInt(s, length)) { +#ifdef TCL_WIDE_INT_IS_LONG long i; result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, objPtr, &i); +#else /* !TCL_WIDE_INT_IS_LONG */ + Tcl_WideInt w; + result = Tcl_GetWideIntFromObj((Tcl_Interp *) NULL, objPtr, &w); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { double d; result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d); @@ -4536,12 +5001,8 @@ ExprUnaryFunc(interp, eePtr, clientData) result = TCL_ERROR; goto done; } - - if (valuePtr->typePtr == &tclIntType) { - d = (double) valuePtr->internalRep.longValue; - } else { - d = valuePtr->internalRep.doubleValue; - } + + GET_DOUBLE_VALUE(d, valuePtr, valuePtr->typePtr); errno = 0; dResult = (*func)(d); @@ -4562,7 +5023,7 @@ ExprUnaryFunc(interp, eePtr, clientData) */ done: - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); return result; } @@ -4607,17 +5068,8 @@ ExprBinaryFunc(interp, eePtr, clientData) goto done; } - if (valuePtr->typePtr == &tclIntType) { - d1 = (double) valuePtr->internalRep.longValue; - } else { - d1 = valuePtr->internalRep.doubleValue; - } - - if (value2Ptr->typePtr == &tclIntType) { - d2 = (double) value2Ptr->internalRep.longValue; - } else { - d2 = value2Ptr->internalRep.doubleValue; - } + GET_DOUBLE_VALUE(d1, valuePtr, valuePtr->typePtr); + GET_DOUBLE_VALUE(d2, value2Ptr, value2Ptr->typePtr); errno = 0; dResult = (*func)(d1, d2); @@ -4638,8 +5090,8 @@ ExprBinaryFunc(interp, eePtr, clientData) */ done: - Tcl_DecrRefCount(valuePtr); - Tcl_DecrRefCount(value2Ptr); + TclDecrRefCount(valuePtr); + TclDecrRefCount(value2Ptr); DECACHE_STACK_INFO(); return result; } @@ -4697,6 +5149,25 @@ ExprAbsFunc(interp, eePtr, clientData) iResult = i; } PUSH_OBJECT(Tcl_NewLongObj(iResult)); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + Tcl_WideInt wResult, w = valuePtr->internalRep.wideValue; + if (w < W0) { + wResult = -w; + if (wResult < 0) { + Tcl_ResetResult(interp); + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "integer value too large to represent", -1); + Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", + "integer value too large to represent", (char *) NULL); + result = TCL_ERROR; + goto done; + } + } else { + wResult = w; + } + PUSH_OBJECT(Tcl_NewWideIntObj(wResult)); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; if (d < 0.0) { @@ -4717,7 +5188,7 @@ ExprAbsFunc(interp, eePtr, clientData) */ done: - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); return result; } @@ -4754,11 +5225,7 @@ ExprDoubleFunc(interp, eePtr, clientData) goto done; } - if (valuePtr->typePtr == &tclIntType) { - dResult = (double) valuePtr->internalRep.longValue; - } else { - dResult = valuePtr->internalRep.doubleValue; - } + GET_DOUBLE_VALUE(dResult, valuePtr, valuePtr->typePtr); /* * Push a Tcl object with the result. @@ -4771,7 +5238,7 @@ ExprDoubleFunc(interp, eePtr, clientData) */ done: - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); return result; } @@ -4811,6 +5278,10 @@ ExprIntFunc(interp, eePtr, clientData) if (valuePtr->typePtr == &tclIntType) { iResult = valuePtr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + iResult = Tcl_WideAsLong(valuePtr->internalRep.wideValue); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; if (d < 0.0) { @@ -4848,11 +5319,92 @@ ExprIntFunc(interp, eePtr, clientData) */ done: - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); return result; } +#ifndef TCL_WIDE_INT_IS_LONG +static int +ExprWideFunc(interp, eePtr, clientData) + Tcl_Interp *interp; /* The interpreter in which to execute the + * function. */ + ExecEnv *eePtr; /* Points to the environment for executing + * the function. */ + ClientData clientData; /* Ignored. */ +{ + Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */ + register int stackTop; /* Cached top index of evaluation stack. */ + register Tcl_Obj *valuePtr; + Tcl_WideInt wResult; + double d; + int result; + + /* + * Set stackPtr and stackTop from eePtr. + */ + + result = TCL_OK; + CACHE_STACK_INFO(); + + /* + * Pop the argument from the evaluation stack. + */ + + valuePtr = POP_OBJECT(); + + if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + + if (valuePtr->typePtr == &tclWideIntType) { + wResult = valuePtr->internalRep.wideValue; + } else if (valuePtr->typePtr == &tclIntType) { + wResult = Tcl_LongAsWide(valuePtr->internalRep.longValue); + } else { + d = valuePtr->internalRep.doubleValue; + if (d < 0.0) { + if (d < Tcl_WideAsDouble(LLONG_MIN)) { + tooLarge: + Tcl_ResetResult(interp); + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "integer value too large to represent", -1); + Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", + "integer value too large to represent", (char *) NULL); + result = TCL_ERROR; + goto done; + } + } else { + if (d > Tcl_WideAsDouble(LLONG_MAX)) { + goto tooLarge; + } + } + if (IS_NAN(d) || IS_INF(d)) { + TclExprFloatError(interp, d); + result = TCL_ERROR; + goto done; + } + wResult = Tcl_DoubleAsWide(d); + } + + /* + * Push a Tcl object with the result. + */ + + PUSH_OBJECT(Tcl_NewWideIntObj(wResult)); + + /* + * Reflect the change to stackTop back in eePtr. + */ + + done: + TclDecrRefCount(valuePtr); + DECACHE_STACK_INFO(); + return result; +} +#endif /* TCL_WIDE_INT_IS_LONG */ + static int ExprRandFunc(interp, eePtr, clientData) Tcl_Interp *interp; /* The interpreter in which to execute the @@ -4876,7 +5428,7 @@ ExprRandFunc(interp, eePtr, clientData) * to insure different seeds in different threads (bug #416643) */ - iPtr->randSeed = TclpGetClicks() + ((long) Tcl_GetCurrentThread() << 12); + iPtr->randSeed = TclpGetClicks() + ((long)Tcl_GetCurrentThread()<<12); /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. @@ -4989,6 +5541,11 @@ ExprRoundFunc(interp, eePtr, clientData) if (valuePtr->typePtr == &tclIntType) { iResult = valuePtr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + PUSH_OBJECT(Tcl_NewWideIntObj(valuePtr->internalRep.wideValue)); + goto done; +#endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; if (d < 0.0) { @@ -5029,7 +5586,7 @@ ExprRoundFunc(interp, eePtr, clientData) */ done: - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); return result; } @@ -5069,6 +5626,10 @@ ExprSrandFunc(interp, eePtr, clientData) if (valuePtr->typePtr == &tclIntType) { i = valuePtr->internalRep.longValue; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + i = Tcl_WideAsLong(valuePtr->internalRep.wideValue); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { /* * At this point, the only other possible type is double @@ -5078,7 +5639,7 @@ ExprSrandFunc(interp, eePtr, clientData) "can't use floating-point value as argument to srand", (char *) NULL); badValue: - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); return TCL_ERROR; } @@ -5101,7 +5662,7 @@ ExprSrandFunc(interp, eePtr, clientData) * function will always succeed. */ - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); DECACHE_STACK_INFO(); ExprRandFunc(interp, eePtr, clientData); @@ -5166,7 +5727,7 @@ ExprCallMathFunc(interp, eePtr, objc, objv) * Look up the MathFunc record for the function. */ - funcName = Tcl_GetString(objv[0]); + funcName = TclGetString(objv[0]); hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName); if (hPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), @@ -5206,15 +5767,39 @@ ExprCallMathFunc(interp, eePtr, objc, objv) if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) { args[k].type = TCL_DOUBLE; args[k].doubleValue = i; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) { + args[k].type = TCL_WIDE_INT; + args[k].wideValue = Tcl_LongAsWide(i); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { args[k].type = TCL_INT; args[k].intValue = i; } +#ifndef TCL_WIDE_INT_IS_LONG + } else if (valuePtr->typePtr == &tclWideIntType) { + Tcl_WideInt w = valuePtr->internalRep.wideValue; + if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) { + args[k].type = TCL_DOUBLE; + args[k].wideValue = Tcl_WideAsDouble(w); + } else if (mathFuncPtr->argTypes[k] == TCL_INT) { + args[k].type = TCL_INT; + args[k].wideValue = Tcl_WideAsLong(w); + } else { + args[k].type = TCL_WIDE_INT; + args[k].wideValue = w; + } +#endif /* TCL_WIDE_INT_IS_LONG */ } else { d = valuePtr->internalRep.doubleValue; if (mathFuncPtr->argTypes[k] == TCL_INT) { args[k].type = TCL_INT; args[k].intValue = (long) d; +#ifndef TCL_WIDE_INT_IS_LONG + } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) { + args[k].type = TCL_WIDE_INT; + args[k].wideValue = Tcl_DoubleAsWide(d); +#endif /* TCL_WIDE_INT_IS_LONG */ } else { args[k].type = TCL_DOUBLE; args[k].doubleValue = d; @@ -5241,7 +5826,7 @@ ExprCallMathFunc(interp, eePtr, objc, objv) i = (stackTop - (objc-1)); while (i <= stackTop) { valuePtr = stackPtr[i]; - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); i++; } stackTop -= objc; diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index db9c6ad..61d4df2 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclFCmd.c,v 1.15 2002/01/17 04:37:33 dgp Exp $ + * RCS: @(#) $Id: tclFCmd.c,v 1.16 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -111,7 +111,7 @@ FileCopyRename(interp, objc, objv, copyFlag) * rename them. */ { int i, result, force; - struct stat statBuf; + Tcl_StatBuf statBuf; Tcl_Obj *target; i = FileForceOption(interp, objc - 2, objv + 2, &force); @@ -229,7 +229,7 @@ TclFileMakeDirsCmd(interp, objc, objv) int result, i, j, pobjc; Tcl_Obj *split = NULL; Tcl_Obj *target = NULL; - struct stat statBuf; + Tcl_StatBuf statBuf; errfile = NULL; @@ -250,9 +250,9 @@ TclFileMakeDirsCmd(interp, objc, objv) target = Tcl_FSJoinPath(split, j + 1); Tcl_IncrRefCount(target); /* - * Call Tcl_Stat() so that if target is a symlink that points - * to a directory we will create subdirectories in that - * directory. + * Call Tcl_FSStat() so that if target is a symlink that + * points to a directory we will create subdirectories in + * that directory. */ if (Tcl_FSStat(target, &statBuf) == 0) { @@ -333,7 +333,7 @@ TclFileDeleteCmd(interp, objc, objv) result = TCL_OK; for ( ; i < objc; i++) { - struct stat statBuf; + Tcl_StatBuf statBuf; errfile = objv[i]; if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) { @@ -448,7 +448,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) { int result; Tcl_Obj *errfile, *errorBuffer; - struct stat sourceStatBuf, targetStatBuf; + Tcl_StatBuf sourceStatBuf, targetStatBuf; if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) { return TCL_ERROR; diff --git a/generic/tclFileName.c b/generic/tclFileName.c index a0e808d..0b698f1 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclFileName.c,v 1.30 2002/02/08 02:52:54 dgp Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.31 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -2467,7 +2467,7 @@ TclDoGlob(interp, separators, headPtr, tail, types) */ Tcl_Obj *nameObj; - struct stat buf; + Tcl_StatBuf buf; /* Used to deal with one special case pertinent to MacOS */ int macSpecialCase = 0; @@ -2597,3 +2597,27 @@ TclFileDirname(interp, pathPtr) Tcl_DecrRefCount(splitPtr); return splitResultPtr; } + +/* + *--------------------------------------------------------------------------- + * + * Tcl_AllocStatBuf + * + * This procedure allocates a Tcl_StatBuf on the heap. It exists + * so that extensions may be used unchanged on systems where + * largefile support is optional. + * + * Results: + * A pointer to a Tcl_StatBuf which may be deallocated by being + * passed to ckfree(). + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +Tcl_StatBuf * +Tcl_AllocStatBuf() { + return (Tcl_StatBuf *) ckalloc(sizeof(Tcl_StatBuf)); +} diff --git a/generic/tclIO.c b/generic/tclIO.c index ed5598c..df8a8c2 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIO.c,v 1.51 2002/01/26 01:10:08 dgp Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.52 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -92,8 +92,7 @@ static int CopyAndTranslateBuffer _ANSI_ARGS_(( ChannelState *statePtr, char *result, int space)); static int CopyBuffer _ANSI_ARGS_(( - Channel *chanPtr, char *result, - int space)); + Channel *chanPtr, char *result, int space)); static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask)); static void CopyEventProc _ANSI_ARGS_((ClientData clientData, int mask)); @@ -130,8 +129,8 @@ static int ReadBytes _ANSI_ARGS_((ChannelState *statePtr, Tcl_Obj *objPtr, int charsLeft, int *offsetPtr)); static int ReadChars _ANSI_ARGS_((ChannelState *statePtr, - Tcl_Obj *objPtr, int charsLeft, int *offsetPtr, - int *factorPtr)); + Tcl_Obj *objPtr, int charsLeft, + int *offsetPtr, int *factorPtr)); static void RecycleBuffer _ANSI_ARGS_((ChannelState *statePtr, ChannelBuffer *bufPtr, int mustDiscard)); static int StackSetBlockMode _ANSI_ARGS_((Channel *chanPtr, @@ -140,11 +139,11 @@ static int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp, Channel *chanPtr, int mode)); static void StopCopy _ANSI_ARGS_((CopyState *csPtr)); static int TranslateInputEOL _ANSI_ARGS_((ChannelState *statePtr, - char *dst, CONST char *src, int *dstLenPtr, - int *srcLenPtr)); + char *dst, CONST char *src, + int *dstLenPtr, int *srcLenPtr)); static int TranslateOutputEOL _ANSI_ARGS_((ChannelState *statePtr, - char *dst, CONST char *src, int *dstLenPtr, - int *srcLenPtr)); + char *dst, CONST char *src, + int *dstLenPtr, int *srcLenPtr)); static void UpdateInterest _ANSI_ARGS_((Channel *chanPtr)); static int WriteBytes _ANSI_ARGS_((Channel *chanPtr, CONST char *src, int srcLen)); @@ -2954,7 +2953,7 @@ WriteBytes(chanPtr, src, srcLen) ChannelState *statePtr = chanPtr->state; /* state info for channel */ ChannelBuffer *bufPtr; char *dst; - int dstLen, dstMax, sawLF, savedLF, total, toWrite; + int dstMax, sawLF, savedLF, total, dstLen, toWrite; total = 0; sawLF = 0; @@ -3042,8 +3041,8 @@ WriteChars(chanPtr, src, srcLen) ChannelState *statePtr = chanPtr->state; /* state info for channel */ ChannelBuffer *bufPtr; char *dst, *stage; - int saved, savedLF, sawLF, total, toWrite, flags; - int dstWrote, dstLen, stageLen, stageMax, stageRead; + int saved, savedLF, sawLF, total, flags, dstLen, stageMax, dstWrote; + int stageLen, toWrite, stageRead; Tcl_Encoding encoding; char safe[BUFFER_PADDING]; @@ -3444,11 +3443,10 @@ Tcl_GetsObj(chan, objPtr) Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* state info for channel */ ChannelBuffer *bufPtr; - int inEofChar, skip, copiedTotal; + int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved; Tcl_Encoding encoding; char *dst, *dstEnd, *eol, *eof; Tcl_EncodingState oldState; - int oldLength, oldFlags, oldRemoved; /* * This operation should occur at the top of a channel stack. @@ -3686,8 +3684,9 @@ Tcl_GetsObj(chan, objPtr) statePtr->inputEncodingState = gs.state; Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved, gs.rawRead, statePtr->inputEncodingFlags, - &statePtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX, - &gs.rawRead, NULL, &gs.charsWrote); + &statePtr->inputEncodingState, dst, + eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL, + &gs.charsWrote); bufPtr->nextRemoved += gs.rawRead; /* @@ -4131,7 +4130,7 @@ Tcl_Read(chan, dst, bytesToRead) int Tcl_ReadRaw(chan, bufPtr, bytesToRead) Tcl_Channel chan; /* The channel from which to read. */ - char *bufPtr; /* Where to store input read. */ + char *bufPtr; /* Where to store input read. */ int bytesToRead; /* Maximum number of bytes to read. */ { Channel *chanPtr = (Channel *) chan; @@ -4464,7 +4463,7 @@ ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr) * output, filled with how many bytes are now * being used. */ { - int toRead, srcLen, srcRead, dstWrote, offset, length; + int toRead, srcLen, offset, length, srcRead, dstWrote; ChannelBuffer *bufPtr; char *src, *dst; @@ -4572,8 +4571,8 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr) * UTF-8. On output, contains another guess * based on the data seen so far. */ { - int toRead, factor, offset, spaceLeft, length; - int srcLen, srcRead, dstNeeded, dstRead, dstWrote, numChars; + int toRead, factor, offset, spaceLeft, length, srcLen, dstNeeded; + int srcRead, dstWrote, numChars, dstRead; ChannelBuffer *bufPtr; char *src, *dst; Tcl_EncodingState oldState; @@ -4586,7 +4585,7 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr) srcLen = bufPtr->nextAdded - bufPtr->nextRemoved; toRead = charsToRead; - if ((unsigned) toRead > (unsigned) srcLen) { + if ((unsigned)toRead > (unsigned)srcLen) { toRead = srcLen; } @@ -5291,17 +5290,17 @@ GetInput(chanPtr) *---------------------------------------------------------------------- */ -int +Tcl_WideInt Tcl_Seek(chan, offset, mode) Tcl_Channel chan; /* The channel on which to seek. */ - int offset; /* Offset to seek to. */ + Tcl_WideInt offset; /* Offset to seek to. */ int mode; /* Relative to which location to seek? */ { Channel *chanPtr = (Channel *) chan; /* The real IO channel. */ ChannelState *statePtr = chanPtr->state; /* state info for channel */ int inputBuffered, outputBuffered; int result; /* Of device driver operations. */ - int curPos; /* Position on the device. */ + Tcl_WideInt curPos; /* Position on the device. */ int wasAsync; /* Was the channel nonblocking before the * seek operation? If so, must restore to * nonblocking mode after the seek. */ @@ -5410,7 +5409,7 @@ Tcl_Seek(chan, offset, mode) */ curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData, - (long) offset, mode, &result); + offset, mode, &result); if (curPos == -1) { Tcl_SetErrno(result); } @@ -5453,7 +5452,7 @@ Tcl_Seek(chan, offset, mode) *---------------------------------------------------------------------- */ -int +Tcl_WideInt Tcl_Tell(chan) Tcl_Channel chan; /* The channel to return pos for. */ { @@ -5461,7 +5460,7 @@ Tcl_Tell(chan) ChannelState *statePtr = chanPtr->state; /* state info for channel */ int inputBuffered, outputBuffered; int result; /* Of calling device driver. */ - int curPos; /* Position on device. */ + Tcl_WideInt curPos; /* Position on device. */ if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) { return -1; @@ -5513,7 +5512,7 @@ Tcl_Tell(chan) */ curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData, - (long) 0, SEEK_CUR, &result); + Tcl_LongAsWide(0), SEEK_CUR, &result); if (curPos == -1) { Tcl_SetErrno(result); return -1; @@ -5527,6 +5526,46 @@ Tcl_Tell(chan) /* *--------------------------------------------------------------------------- * + * Tcl_SeekOld, Tcl_TellOld -- + * + * Backward-compatability versions of the seek/tell interface that + * do not support 64-bit offsets. + * + * Results: + * As for Tcl_Seek and Tcl_Tell respectively. + * + * Side effects: + * As for Tcl_Seek and Tcl_Tell respectively. + * + *--------------------------------------------------------------------------- + */ + +int +Tcl_SeekOld(chan, offset, mode) + Tcl_Channel chan; /* The channel on which to seek. */ + int offset; /* Offset to seek to. */ + int mode; /* Relative to which location to seek? */ +{ + Tcl_WideInt wOffset, wResult; + + wOffset = Tcl_LongAsWide((long)offset); + wResult = Tcl_Seek(chan, wOffset, mode); + return (int)Tcl_WideAsLong(wResult); +} + +int +Tcl_TellOld(chan) + Tcl_Channel chan; /* The channel to return pos for. */ +{ + Tcl_WideInt wResult; + + wResult = Tcl_Tell(chan); + return (int)Tcl_WideAsLong(wResult); +} + +/* + *--------------------------------------------------------------------------- + * * CheckChannelErrors -- * * See if the channel is in an ready state and can perform the @@ -7378,14 +7417,10 @@ CopyData(csPtr, mask) int mask; /* Current channel event flags. */ { Tcl_Interp *interp; - Tcl_Obj *cmdPtr, *errObj = NULL; + Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL; Tcl_Channel inChan, outChan; ChannelState *inStatePtr, *outStatePtr; - int result = TCL_OK; - int size; - int total; - int sizeb; - Tcl_Obj* bufObj = NULL; + int result = TCL_OK, size, total, sizeb; char* buffer; int inBinary, outBinary, sameEncoding; /* Encoding control */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 54d0d5c..bb2b567 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOCmd.c,v 1.14 2002/02/14 19:24:15 andreas_kupries Exp $ + * RCS: @(#) $Id: tclIOCmd.c,v 1.15 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -416,8 +416,9 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Channel chan; /* The channel to tell on. */ - int offset, mode; /* Where to seek? */ - int result; /* Of calling Tcl_Seek. */ + Tcl_WideInt offset; /* Where to seek? */ + int mode; /* How to seek? */ + Tcl_WideInt result; /* Of calling Tcl_Seek. */ char *chanName; int optionIndex; static CONST char *originOptions[] = { @@ -434,7 +435,7 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv) if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[2], &offset) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) { return TCL_ERROR; } mode = SEEK_SET; @@ -447,7 +448,7 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv) } result = Tcl_Seek(chan, offset, mode); - if (result == -1) { + if (result == Tcl_LongAsWide(-1)) { Tcl_AppendResult(interp, "error during seek on \"", chanName, "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; @@ -497,7 +498,7 @@ Tcl_TellObjCmd(clientData, interp, objc, objv) if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan)); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan)); return TCL_OK; } diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 4071217..c48ce18 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * CVS: $Id: tclIOGT.c,v 1.4 2002/01/15 17:55:30 dgp Exp $ + * CVS: $Id: tclIOGT.c,v 1.5 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -33,8 +33,8 @@ static int TransformInputProc _ANSI_ARGS_ (( static int TransformOutputProc _ANSI_ARGS_ (( ClientData instanceData, CONST char *buf, int toWrite, int* errorCodePtr)); -static int TransformSeekProc _ANSI_ARGS_ (( - ClientData instanceData, long offset, +static Tcl_WideInt TransformSeekProc _ANSI_ARGS_ (( + ClientData instanceData, Tcl_WideInt offset, int mode, int* errorCodePtr)); static int TransformSetOptionProc _ANSI_ARGS_(( ClientData instanceData, Tcl_Interp *interp, @@ -156,8 +156,8 @@ static Tcl_ChannelType transformChannelType = { struct ResultBuffer { unsigned char* buf; /* Reference to the buffer area */ - int allocated; /* Allocated size of the buffer area */ - int used; /* Number of bytes in the buffer, <= allocated */ + int allocated; /* Allocated size of the buffer area */ + int used; /* Number of bytes in the buffer, <= allocated */ }; /* @@ -357,11 +357,11 @@ TclChannelTransform(interp, chan, cmdObjPtr) static int ExecuteCallback (dataPtr, interp, op, buf, bufLen, transmit, preserve) - TransformChannelData* dataPtr; /* Transformation with the callback */ + TransformChannelData* dataPtr; /* Transformation with the callback */ Tcl_Interp* interp; /* Current interpreter, possibly NULL */ unsigned char* op; /* Operation invoking the callback */ unsigned char* buf; /* Buffer to give to the script. */ - int bufLen; /* Ands its length */ + int bufLen; /* Ands its length */ int transmit; /* Flag, determines whether the result * of the callback is sent to the * underlying channel or not. */ @@ -377,16 +377,14 @@ ExecuteCallback (dataPtr, interp, op, buf, bufLen, transmit, preserve) * arguments. Feather's curried commands would come in handy here. */ - Tcl_Obj* resObj; /* See below, switch (transmit) */ - int resLen; - unsigned char* resBuf; + Tcl_Obj* resObj; /* See below, switch (transmit) */ + int resLen; + unsigned char* resBuf; Tcl_SavedResult ciSave; - int res = TCL_OK; Tcl_Obj* command = Tcl_DuplicateObj (dataPtr->command); Tcl_Obj* temp; - if (preserve) { Tcl_SaveResult (dataPtr->interp, &ciSave); } @@ -641,7 +639,7 @@ static int TransformInputProc (instanceData, buf, toRead, errorCodePtr) ClientData instanceData; char* buf; - int toRead; + int toRead; int* errorCodePtr; { TransformChannelData* dataPtr = (TransformChannelData*) instanceData; @@ -764,8 +762,7 @@ TransformInputProc (instanceData, buf, toRead, errorCodePtr) */ res = ExecuteCallback (dataPtr, NO_INTERP, A_READ, - UCHARP (buf), read, TRANSMIT_IBUF, - P_PRESERVE); + UCHARP (buf), read, TRANSMIT_IBUF, P_PRESERVE); if (res != TCL_OK) { *errorCodePtr = EINVAL; @@ -846,12 +843,12 @@ TransformOutputProc (instanceData, buf, toWrite, errorCodePtr) *------------------------------------------------------* */ -static int +static Tcl_WideInt TransformSeekProc (instanceData, offset, mode, errorCodePtr) - ClientData instanceData; /* The channel to manipulate */ - long offset; /* Size of movement. */ - int mode; /* How to move */ - int* errorCodePtr; /* Location of error flag. */ + ClientData instanceData; /* The channel to manipulate */ + Tcl_WideInt offset; /* Size of movement. */ + int mode; /* How to move */ + int* errorCodePtr; /* Location of error flag. */ { int result; TransformChannelData* dataPtr = (TransformChannelData*) instanceData; @@ -1274,7 +1271,7 @@ static int ResultCopy (r, buf, toRead) ResultBuffer* r; /* The buffer to read from */ unsigned char* buf; /* The buffer to copy into */ - int toRead; /* Number of requested bytes */ + int toRead; /* Number of requested bytes */ { if (r->used == 0) { /* Nothing to copy in the case of an empty buffer. @@ -1337,7 +1334,7 @@ static void ResultAdd (r, buf, toWrite) ResultBuffer* r; /* The buffer to extend */ unsigned char* buf; /* The buffer to read from */ - int toWrite; /* The number of bytes in 'buf' */ + int toWrite; /* The number of bytes in 'buf' */ { if ((r->used + toWrite) > r->allocated) { /* Extension of the internal buffer is required. diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index f972b2c..bdea467 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.34 2002/02/08 02:52:54 dgp Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.35 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -80,15 +80,63 @@ extern CONST TclFileAttrProcs tclpFileAttrProcs[]; /* Obsolete */ int -Tcl_Stat(path, buf) +Tcl_Stat(path, oldStyleBuf) CONST char *path; /* Path of file to stat (in current CP). */ - struct stat *buf; /* Filled with results of stat call. */ + struct stat *oldStyleBuf; /* Filled with results of stat call. */ { int ret; + Tcl_StatBuf buf; Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); + Tcl_IncrRefCount(pathPtr); - ret = Tcl_FSStat(pathPtr,buf); + ret = Tcl_FSStat(pathPtr, &buf); Tcl_DecrRefCount(pathPtr); + if (ret != -1) { +#ifndef TCL_WIDE_INT_IS_LONG +# define OUT_OF_RANGE(x) \ + (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \ + ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX)) +# define OUT_OF_URANGE(x) \ + (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX) + + /* + * Perform the result-buffer overflow check manually. + * + * Note that ino_t/ino64_t is unsigned... + */ + + if (OUT_OF_URANGE(buf.st_ino) || OUT_OF_RANGE(buf.st_size) + || OUT_OF_RANGE(buf.st_blocks)) { + errno = EOVERFLOW; + return -1; + } + +# undef OUT_OF_RANGE +# undef OUT_OF_URANGE +#endif /* !TCL_WIDE_INT_IS_LONG */ + + /* + * Copy across all supported fields, with possible type + * coercions on those fields that change between the normal + * and lf64 versions of the stat structure (on Solaris at + * least.) This is slow when the structure sizes coincide, + * but that's what you get for using an obsolete interface. + */ + + oldStyleBuf->st_mode = buf.st_mode; + oldStyleBuf->st_ino = (ino_t) buf.st_ino; + oldStyleBuf->st_dev = buf.st_dev; + oldStyleBuf->st_rdev = buf.st_rdev; + oldStyleBuf->st_nlink = buf.st_nlink; + oldStyleBuf->st_uid = buf.st_uid; + oldStyleBuf->st_gid = buf.st_gid; + oldStyleBuf->st_size = (off_t) buf.st_size; + oldStyleBuf->st_atime = buf.st_atime; + oldStyleBuf->st_mtime = buf.st_mtime; + oldStyleBuf->st_ctime = buf.st_ctime; + oldStyleBuf->st_blksize = buf.st_blksize; + oldStyleBuf->st_blocks = (blkcnt_t) buf.st_blocks; + } return ret; } @@ -1150,7 +1198,7 @@ Tcl_FSEvalFile(interp, pathPtr) * will be performed on this name. */ { int result, length; - struct stat statBuf; + Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile; Interp *iPtr; char *string; @@ -1334,11 +1382,12 @@ Tcl_PosixError(interp) int Tcl_FSStat(pathPtr, buf) Tcl_Obj *pathPtr; /* Path of file to stat (in current CP). */ - struct stat *buf; /* Filled with results of stat call. */ + Tcl_StatBuf *buf; /* Filled with results of stat call. */ { Tcl_Filesystem *fsPtr; #ifdef USE_OBSOLETE_FS_HOOKS StatProc *statProcPtr; + struct stat oldStyleStatBuffer; int retVal = -1; char *path; Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); @@ -1356,11 +1405,28 @@ Tcl_FSStat(pathPtr, buf) Tcl_MutexLock(&obsoleteFsHookMutex); statProcPtr = statProcList; while ((retVal == -1) && (statProcPtr != NULL)) { - retVal = (*statProcPtr->proc)(path, buf); + retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer); statProcPtr = statProcPtr->nextPtr; } Tcl_MutexUnlock(&obsoleteFsHookMutex); if (retVal != -1) { + /* + * Note that EOVERFLOW is not a problem here, and these + * assignments should all be widening (if not identity.) + */ + buf->st_mode = oldStyleStatBuffer.st_mode; + buf->st_ino = (Tcl_WideUInt) Tcl_LongAsWide(oldStyleStatBuffer.st_ino); + buf->st_dev = oldStyleStatBuffer.st_dev; + buf->st_rdev = oldStyleStatBuffer.st_rdev; + buf->st_nlink = oldStyleStatBuffer.st_nlink; + buf->st_uid = oldStyleStatBuffer.st_uid; + buf->st_gid = oldStyleStatBuffer.st_gid; + buf->st_size = Tcl_LongAsWide(oldStyleStatBuffer.st_size); + buf->st_atime = oldStyleStatBuffer.st_atime; + buf->st_mtime = oldStyleStatBuffer.st_mtime; + buf->st_ctime = oldStyleStatBuffer.st_ctime; + buf->st_blksize = oldStyleStatBuffer.st_blksize; + buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks); return retVal; } #endif /* USE_OBSOLETE_FS_HOOKS */ @@ -1398,7 +1464,7 @@ Tcl_FSStat(pathPtr, buf) int Tcl_FSLstat(pathPtr, buf) Tcl_Obj *pathPtr; /* Path of file to stat (in current CP). */ - struct stat *buf; /* Filled with results of stat call. */ + Tcl_StatBuf *buf; /* Filled with results of stat call. */ { Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { @@ -2165,7 +2231,7 @@ Tcl_FSChdir(pathPtr) retVal = (*proc)(pathPtr); } else { /* Fallback on stat-based implementation */ - struct stat buf; + Tcl_StatBuf buf; /* If the file can be stat'ed and is a directory and * is readable, then we can chdir. */ if ((Tcl_FSStat(pathPtr, &buf) == 0) @@ -3057,7 +3123,7 @@ TclCrossFilesystemCopy(interp, source, target) /* This is very strange, we checked this above */ Tcl_Close(interp, out); } else { - struct stat sourceStatBuf; + Tcl_StatBuf sourceStatBuf; struct utimbuf tval; /* * Copy it synchronously. We might wish to add an diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index c9baf3c..4b5dfe4 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -10,10 +10,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIndexObj.c,v 1.12 2002/01/17 04:37:33 dgp Exp $ + * RCS: @(#) $Id: tclIndexObj.c,v 1.13 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" +#include "tclPort.h" /* * Prototypes for procedures defined later in this file: @@ -21,6 +22,10 @@ static int SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); +static void UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *objPtr)); +static void DupIndex _ANSI_ARGS_((Tcl_Obj *srcPtr, + Tcl_Obj *dupPtr)); +static void FreeIndex _ANSI_ARGS_((Tcl_Obj *objPtr)); /* * The structure below defines the index Tcl object type by means of @@ -29,21 +34,44 @@ static int SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ObjType tclIndexType = { "index", /* name */ - (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */ - (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */ - (Tcl_UpdateStringProc *) NULL, /* updateStringProc */ + FreeIndex, /* freeIntRepProc */ + DupIndex, /* dupIntRepProc */ + UpdateStringOfIndex, /* updateStringProc */ SetIndexFromAny /* setFromAnyProc */ }; /* - * DKF - Just noting that the data format used in objects with the - * above type is that the ptr1 field will contain a pointer to the - * table that the last lookup was performed in, and the ptr2 field - * will contain the sizeof(char) offset of the string within that - * table. Note that we assume that each table is only ever called - * with a single offset, but this is a pretty safe assumption in - * practise... + * The definition of the internal representation of the "index" + * object; The internalRep.otherValuePtr field of an object of "index" + * type will be a pointer to one of these structures. + * + * Keep this structure declaration in sync with tclTestObj.c + */ + +typedef struct { + VOID *tablePtr; /* Pointer to the table of strings */ + int offset; /* Offset between table entries */ + int index; /* Selected index into table. */ +} IndexRep; + +/* + * The following macros greatly simplify moving through a table... + * + * SunPro CC prohibits address arithmetic on (void *) values, so + * use (char *) on that platform/build-environment instead. */ +#ifdef __sparc +# define STRING_AT(table, offset, index) \ + (*((CONST char * CONST *)(((char *)(table)) + ((offset) * (index))))) +#else +# define STRING_AT(table, offset, index) \ + (*((CONST char * CONST *)(((VOID *)(table)) + (ptrdiff_t)((offset) * (index))))) +#endif +#define NEXT_ENTRY(table, offset) \ + (&(STRING_AT(table, offset, 1))) +#define EXPAND_OF(indexRep) \ + STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index) + /* *---------------------------------------------------------------------- @@ -91,11 +119,17 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) * is cached). */ - if ((objPtr->typePtr == &tclIndexType) - && (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr)) { - *indexPtr = ((int) objPtr->internalRep.twoPtrValue.ptr2) - / sizeof(char *); - return TCL_OK; + if (objPtr->typePtr == &tclIndexType) { + IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; + /* + * Here's hoping we don't get hit by unfortunate packing + * constraints on odd platforms like a Cray PVP... + */ + if (indexRep->tablePtr == (VOID *)tablePtr && + indexRep->offset == sizeof(char *)) { + *indexPtr = indexRep->index; + return TCL_OK; + } } return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *), msg, flags, indexPtr); @@ -150,15 +184,18 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, CONST char *p2; CONST char * CONST *entryPtr; Tcl_Obj *resultPtr; + IndexRep *indexRep; /* * See if there is a valid cached result from a previous lookup. */ - if ((objPtr->typePtr == &tclIndexType) - && (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr)) { - *indexPtr = ((int) objPtr->internalRep.twoPtrValue.ptr2) / offset; - return TCL_OK; + if (objPtr->typePtr == &tclIndexType) { + indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; + if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { + *indexPtr = indexRep->index; + return TCL_OK; + } } /* @@ -178,15 +215,21 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, goto error; } + /* + * Scan the table looking for one of: + * - An exact match (always preferred) + * - A single abbreviation (allowed depending on flags) + * - Several abbreviations (never allowed, but overridden by exact match) + */ for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; - entryPtr = (CONST char **) ((char *)entryPtr + offset), i++) { + entryPtr = NEXT_ENTRY(entryPtr, offset), i++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { - if (*p1 == 0) { + if (*p1 == '\0') { index = i; goto done; } } - if (*p1 == 0) { + if (*p1 == '\0') { /* * The value is an abbreviation for this entry. Continue * checking other entries to make sure it's unique. If we @@ -199,36 +242,51 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, index = i; } } + /* + * Check if we were instructed to disallow abbreviations. + */ if ((flags & TCL_EXACT) || (numAbbrev != 1)) { goto error; } done: - if ((objPtr->typePtr != NULL) - && (objPtr->typePtr->freeIntRepProc != NULL)) { - objPtr->typePtr->freeIntRepProc(objPtr); - } - objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr; /* - * Make sure to account for offsets != sizeof(char *). [Bug 5153] + * Cache the found representation. Note that we want to avoid + * allocating a new internal-rep if at all possible since that is + * potentially a slow operation. */ - objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) (index * offset); - objPtr->typePtr = &tclIndexType; + if (objPtr->typePtr == &tclIndexType) { + indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; + } else { + if ((objPtr->typePtr != NULL) + && (objPtr->typePtr->freeIntRepProc != NULL)) { + objPtr->typePtr->freeIntRepProc(objPtr); + } + indexRep = (IndexRep *) ckalloc(sizeof(IndexRep)); + objPtr->internalRep.otherValuePtr = (VOID *) indexRep; + objPtr->typePtr = &tclIndexType; + } + indexRep->tablePtr = tablePtr; + indexRep->offset = offset; + indexRep->index = index; + *indexPtr = index; return TCL_OK; error: if (interp != NULL) { + /* + * Produce a fancy error message. + */ int count; resultPtr = Tcl_GetObjResult(interp); Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) ? "ambiguous " : "bad ", msg, " \"", key, "\": must be ", *tablePtr, (char *) NULL); - for (entryPtr = (CONST char **)((char *)tablePtr + offset), count = 0; + for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0; *entryPtr != NULL; - entryPtr = (CONST char **)((char *)entryPtr + offset), - count++) { - if ((*((char **) ((char *) entryPtr + offset))) == NULL) { + entryPtr = NEXT_ENTRY(entryPtr, offset), count++) { + if (*NEXT_ENTRY(entryPtr, offset) == NULL) { Tcl_AppendStringsToObj(resultPtr, (count > 0) ? ", or " : " or ", *entryPtr, (char *) NULL); @@ -275,6 +333,94 @@ SetIndexFromAny(interp, objPtr) /* *---------------------------------------------------------------------- * + * UpdateStringOfIndex -- + * + * This procedure is called to convert a Tcl object from index + * internal form to its string form. No abbreviation is ever + * generated. + * + * Results: + * None. + * + * Side effects: + * The string representation of the object is updated. + * + *---------------------------------------------------------------------- + */ + +static void +UpdateStringOfIndex(objPtr) + Tcl_Obj *objPtr; +{ + IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr; + register char *buf; + register unsigned len; + register CONST char *indexStr = EXPAND_OF(indexRep); + + len = strlen(indexStr); + buf = (char *) ckalloc(len + 1); + memcpy(buf, indexStr, len+1); + objPtr->bytes = buf; + objPtr->length = len; +} + +/* + *---------------------------------------------------------------------- + * + * DupIndex -- + * + * This procedure is called to copy the internal rep of an index + * Tcl object from to another object. + * + * Results: + * None. + * + * Side effects: + * The internal representation of the target object is updated + * and the type is set. + * + *---------------------------------------------------------------------- + */ + +static void +DupIndex(srcPtr, dupPtr) + Tcl_Obj *srcPtr, *dupPtr; +{ + IndexRep *srcIndexRep = (IndexRep *) srcPtr->internalRep.otherValuePtr; + IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep)); + + memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep)); + dupPtr->internalRep.otherValuePtr = (VOID *) dupIndexRep; + dupPtr->typePtr = &tclIndexType; +} + +/* + *---------------------------------------------------------------------- + * + * FreeIndex -- + * + * This procedure is called to delete the internal rep of an index + * Tcl object. + * + * Results: + * None. + * + * Side effects: + * The internal representation of the target object is deleted. + * + *---------------------------------------------------------------------- + */ + +static void +FreeIndex(objPtr) + Tcl_Obj *objPtr; +{ + ckfree((char *) objPtr->internalRep.otherValuePtr); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_WrongNumArgs -- * * This procedure generates a "wrong # args" error message in an @@ -309,8 +455,8 @@ Tcl_WrongNumArgs(interp, objc, objv, message) * message may be NULL. */ { Tcl_Obj *objPtr; - char **tablePtr; - int i, offset; + int i; + register IndexRep *indexRep; objPtr = Tcl_GetObjResult(interp); Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1); @@ -322,11 +468,8 @@ Tcl_WrongNumArgs(interp, objc, objv, message) */ if (objv[i]->typePtr == &tclIndexType) { - tablePtr = ((char **) objv[i]->internalRep.twoPtrValue.ptr1); - offset = ((int) objv[i]->internalRep.twoPtrValue.ptr2); - Tcl_AppendStringsToObj(objPtr, - *((char **)(((char *)tablePtr)+offset)), - (char *) NULL); + indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr; + Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *) NULL); } else { Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]), (char *) NULL); diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 67bd6f7..912c596 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclInt.decls,v 1.45 2002/01/27 11:09:30 das Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.46 2002/02/15 14:28:49 dkf Exp $ library tcl @@ -43,7 +43,7 @@ declare 3 generic { # int TclChdir(Tcl_Interp *interp, char *dirName) # } declare 5 {unix win} { - int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, \ + int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan) } declare 6 generic { @@ -53,20 +53,20 @@ declare 7 generic { int TclCopyAndCollapse(int count, CONST char *src, char *dst) } declare 8 generic { - int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, \ + int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) } # TclCreatePipeline unofficially exported for use by BLT. declare 9 {unix win} { - int TclCreatePipeline(Tcl_Interp *interp, int argc, CONST char **argv, \ - Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, \ + int TclCreatePipeline(Tcl_Interp *interp, int argc, CONST char **argv, + Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr) } declare 10 generic { int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr, - CONST char *procName, + CONST char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr) } declare 11 generic { @@ -76,7 +76,7 @@ declare 12 generic { void TclDeleteVars(Interp *iPtr, Tcl_HashTable *tablePtr) } declare 13 generic { - int TclDoGlob(Tcl_Interp *interp, char *separators, \ + int TclDoGlob(Tcl_Interp *interp, char *separators, Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types) } declare 14 generic { @@ -106,8 +106,8 @@ declare 16 generic { # int TclFileRenameCmd(Tcl_Interp *interp, int argc, char **argv) #} declare 22 generic { - int TclFindElement(Tcl_Interp *interp, CONST char *listStr, \ - int listLength, CONST char **elementPtr, CONST char **nextPtr, \ + int TclFindElement(Tcl_Interp *interp, CONST char *listStr, + int listLength, CONST char **elementPtr, CONST char **nextPtr, int *sizePtr, int *bracePtr) } declare 23 generic { @@ -124,14 +124,14 @@ declare 25 generic { # char * TclGetCwd(Tcl_Interp *interp) # } declare 27 generic { - int TclGetDate(char *p, unsigned long now, long zone, \ + int TclGetDate(char *p, unsigned long now, long zone, unsigned long *timePtr) } declare 28 generic { Tcl_Channel TclpGetDefaultStdChannel(int type) } declare 29 generic { - Tcl_Obj * TclGetElementOfIndexedArray(Tcl_Interp *interp, \ + Tcl_Obj * TclGetElementOfIndexedArray(Tcl_Interp *interp, int localIndex, Tcl_Obj *elemPtr, int flags) } # Replaced by char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr) in 8.1: @@ -142,18 +142,18 @@ declare 31 generic { char * TclGetExtension(char *name) } declare 32 generic { - int TclGetFrame(Tcl_Interp *interp, CONST char *str, \ + int TclGetFrame(Tcl_Interp *interp, CONST char *str, CallFrame **framePtrPtr) } declare 33 generic { TclCmdProcType TclGetInterpProc(void) } declare 34 generic { - int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, \ + int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr) } declare 35 generic { - Tcl_Obj * TclGetIndexedScalar(Tcl_Interp *interp, int localIndex, \ + Tcl_Obj * TclGetIndexedScalar(Tcl_Interp *interp, int localIndex, int flags) } declare 36 generic { @@ -163,9 +163,9 @@ declare 37 generic { int TclGetLoadedPackages(Tcl_Interp *interp, char *targetName) } declare 38 generic { - int TclGetNamespaceForQualName(Tcl_Interp *interp, CONST char *qualName, \ - Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, \ - Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, \ + int TclGetNamespaceForQualName(Tcl_Interp *interp, CONST char *qualName, + Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, + Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, CONST char **simpleNamePtr) } declare 39 generic { @@ -193,19 +193,19 @@ declare 46 generic { int TclInExit(void) } declare 47 generic { - Tcl_Obj * TclIncrElementOfIndexedArray(Tcl_Interp *interp, \ + Tcl_Obj * TclIncrElementOfIndexedArray(Tcl_Interp *interp, int localIndex, Tcl_Obj *elemPtr, long incrAmount) } declare 48 generic { - Tcl_Obj * TclIncrIndexedScalar(Tcl_Interp *interp, int localIndex, \ + Tcl_Obj * TclIncrIndexedScalar(Tcl_Interp *interp, int localIndex, long incrAmount) } declare 49 generic { - Tcl_Obj * TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, \ + Tcl_Obj * TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed) } declare 50 generic { - void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, \ + void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr) } declare 51 generic { @@ -215,11 +215,11 @@ declare 52 generic { int TclInvoke(Tcl_Interp *interp, int argc, char **argv, int flags) } declare 53 generic { - int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, \ + int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) } declare 54 generic { - int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, \ + int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) } declare 55 generic { @@ -227,8 +227,8 @@ declare 55 generic { } # Replaced with TclpLoadFile in 8.1: # declare 56 generic { -# int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \ -# char *sym2, Tcl_PackageInitProc **proc1Ptr, \ +# int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, +# char *sym2, Tcl_PackageInitProc **proc1Ptr, # Tcl_PackageInitProc **proc2Ptr) # } # Signature changed to take a length in 8.1: @@ -236,13 +236,13 @@ declare 55 generic { # int TclLooksLikeInt(char *p) # } declare 58 generic { - Var * TclLookupVar(Tcl_Interp *interp, char *part1, char *part2, \ - int flags, char *msg, int createPart1, int createPart2, \ + Var * TclLookupVar(Tcl_Interp *interp, char *part1, char *part2, + int flags, char *msg, int createPart1, int createPart2, Var **arrayPtrPtr) } # Replaced by Tcl_FSMatchInDirectory in 8.4 #declare 59 generic { -# int TclpMatchFiles(Tcl_Interp *interp, char *separators, \ +# int TclpMatchFiles(Tcl_Interp *interp, char *separators, # Tcl_DString *dirPtr, char *pattern, char *tail) #} declare 60 generic { @@ -255,15 +255,15 @@ declare 62 generic { int TclObjCommandComplete(Tcl_Obj *cmdPtr) } declare 63 generic { - int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, \ + int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) } declare 64 generic { - int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], \ + int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags) } declare 65 generic { - int TclObjInvokeGlobal(Tcl_Interp *interp, int objc, \ + int TclObjInvokeGlobal(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags) } declare 66 generic { @@ -283,7 +283,7 @@ declare 69 generic { # int TclpCopyFile(CONST char *source, CONST char *dest) #} #declare 71 generic { -# int TclpCopyDirectory(CONST char *source, CONST char *dest, \ +# int TclpCopyDirectory(CONST char *source, CONST char *dest, # Tcl_DString *errorPtr) #} #declare 72 generic { @@ -316,14 +316,14 @@ declare 78 generic { #} # Replaced by Tcl_FSOpenFileChannel in 8.4: #declare 80 generic { -# Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName, \ +# Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName, # char *modeString, int permissions) #} declare 81 generic { char * TclpRealloc(char *ptr, unsigned int size) } #declare 82 generic { -# int TclpRemoveDirectory(CONST char *path, int recursive, \ +# int TclpRemoveDirectory(CONST char *path, int recursive, # Tcl_DString *errorPtr) #} #declare 83 generic { @@ -331,26 +331,26 @@ declare 81 generic { #} # Removed in 8.1: # declare 84 generic { -# int TclParseBraces(Tcl_Interp *interp, char *str, char **termPtr, \ +# int TclParseBraces(Tcl_Interp *interp, char *str, char **termPtr, # ParseValue *pvPtr) # } # declare 85 generic { -# int TclParseNestedCmd(Tcl_Interp *interp, char *str, int flags, \ +# int TclParseNestedCmd(Tcl_Interp *interp, char *str, int flags, # char **termPtr, ParseValue *pvPtr) # } # declare 86 generic { -# int TclParseQuotes(Tcl_Interp *interp, char *str, int termChar, \ +# int TclParseQuotes(Tcl_Interp *interp, char *str, int termChar, # int flags, char **termPtr, ParseValue *pvPtr) # } # declare 87 generic { # void TclPlatformInit(Tcl_Interp *interp) # } declare 88 generic { - char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, \ + char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags) } declare 89 generic { - int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, \ + int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd) } # Removed in 8.1 (only available if compiled with TCL_COMPILE_DEBUG): @@ -361,20 +361,20 @@ declare 91 generic { void TclProcCleanupProc(Proc *procPtr) } declare 92 generic { - int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, \ - Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, \ + int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, + Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName) } declare 93 generic { void TclProcDeleteProc(ClientData clientData) } declare 94 generic { - int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, \ + int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) } # Replaced by Tcl_FSStat in 8.4: #declare 95 generic { -# int TclpStat(CONST char *path, struct stat *buf) +# int TclpStat(CONST char *path, Tcl_StatBuf *buf) #} declare 96 generic { int TclRenameCommand(Tcl_Interp *interp, char *oldName, char *newName) @@ -386,11 +386,11 @@ declare 98 generic { int TclServiceIdle(void) } declare 99 generic { - Tcl_Obj * TclSetElementOfIndexedArray(Tcl_Interp *interp, \ - int localIndex, Tcl_Obj *elemPtr, Tcl_Obj *objPtr, int flags) + Tcl_Obj * TclSetElementOfIndexedArray(Tcl_Interp *interp, int localIndex, + Tcl_Obj *elemPtr, Tcl_Obj *objPtr, int flags) } declare 100 generic { - Tcl_Obj * TclSetIndexedScalar(Tcl_Interp *interp, int localIndex, \ + Tcl_Obj * TclSetIndexedScalar(Tcl_Interp *interp, int localIndex, Tcl_Obj *objPtr, int flags) } declare 101 {unix win} { @@ -400,7 +400,7 @@ declare 102 generic { void TclSetupEnv(Tcl_Interp *interp) } declare 103 generic { - int TclSockGetPort(Tcl_Interp *interp, char *str, char *proto, \ + int TclSockGetPort(Tcl_Interp *interp, char *str, char *proto, int *portPtr) } declare 104 {unix win} { @@ -408,7 +408,7 @@ declare 104 {unix win} { } # Replaced by Tcl_FSStat in 8.4: #declare 105 generic { -# int TclStat(CONST char *path, struct stat *buf) +# int TclStat(CONST char *path, Tcl_StatBuf *buf) #} declare 106 generic { int TclStatDeleteProc(TclStatProc_ *proc) @@ -431,54 +431,54 @@ declare 109 generic { # defined here instead of in tcl.decls since they are not stable yet. declare 111 generic { - void Tcl_AddInterpResolvers(Tcl_Interp *interp, CONST char *name, \ - Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, \ + void Tcl_AddInterpResolvers(Tcl_Interp *interp, CONST char *name, + Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } declare 112 generic { - int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, \ + int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr) } declare 113 generic { - Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, CONST char *name, \ + Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) } declare 114 generic { void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) } declare 115 generic { - int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, \ + int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int resetListFirst) } declare 116 generic { - Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, CONST char *name, \ + Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags) } declare 117 generic { - Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, CONST char *name, \ + Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags) } declare 118 generic { - int Tcl_GetInterpResolvers(Tcl_Interp *interp, CONST char *name, \ + int Tcl_GetInterpResolvers(Tcl_Interp *interp, CONST char *name, Tcl_ResolverInfo *resInfo) } declare 119 generic { - int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr, \ + int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo) } declare 120 generic { - Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, char *name, \ + Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, char *name, Tcl_Namespace *contextNsPtr, int flags) } declare 121 generic { - int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, \ + int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern) } declare 122 generic { Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) } declare 123 generic { - void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, \ + void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr) } declare 124 generic { @@ -488,26 +488,26 @@ declare 125 generic { Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp) } declare 126 generic { - void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, \ + void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr) } declare 127 generic { - int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, \ + int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int allowOverwrite) } declare 128 generic { void Tcl_PopCallFrame(Tcl_Interp* interp) } declare 129 generic { - int Tcl_PushCallFrame(Tcl_Interp* interp, Tcl_CallFrame *framePtr, \ + int Tcl_PushCallFrame(Tcl_Interp* interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame) } declare 130 generic { int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, CONST char *name) } declare 131 generic { - void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr, \ - Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, \ + void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr, + Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } declare 132 generic { @@ -517,7 +517,7 @@ declare 133 generic { struct tm * TclpGetDate(TclpTime_t time, int useGMT) } declare 134 generic { - size_t TclpStrftime(char *s, size_t maxsize, CONST char *format, \ + size_t TclpStrftime(char *s, size_t maxsize, CONST char *format, CONST struct tm *t) } declare 135 generic { @@ -533,8 +533,8 @@ declare 138 generic { CONST char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr) } #declare 139 generic { -# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \ -# char *sym2, Tcl_PackageInitProc **proc1Ptr, \ +# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, +# char *sym2, Tcl_PackageInitProc **proc1Ptr, # Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr) #} declare 140 generic { @@ -545,15 +545,15 @@ declare 141 generic { CONST char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } declare 142 generic { - int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, \ + int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData) } declare 143 generic { - int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, \ + int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr) } declare 144 generic { - void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr, \ + void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr, int index) } declare 145 generic { @@ -582,7 +582,7 @@ declare 150 generic { int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re) } declare 151 generic { - void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, \ + void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, int *endPtr) } @@ -599,12 +599,12 @@ declare 153 generic { # Tcl_Interp *interp, int argc, char **argv) #} #declare 155 generic { -# int TclTestChannelEventCmd(ClientData clientData, \ +# int TclTestChannelEventCmd(ClientData clientData, # Tcl_Interp *interp, int argc, char **argv) #} declare 156 generic { - void TclRegError (Tcl_Interp *interp, CONST char *msg, \ + void TclRegError (Tcl_Interp *interp, CONST char *msg, int status) } declare 157 generic { @@ -617,13 +617,13 @@ declare 159 generic { CONST char *TclGetStartupScriptFileName(void) } #declare 160 generic { -# int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, \ +# int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, # Tcl_DString *dirPtr, char *pattern, char *tail, GlobTypeData *types) #} # new in 8.3.2/8.4a2 declare 161 generic { - int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, \ + int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr) } declare 162 generic { @@ -654,10 +654,8 @@ declare 165 generic { # New function due to TIP #33 declare 166 generic { - int TclListObjSetElement( Tcl_Interp* interp, - Tcl_Obj* listPtr, - int index, - Tcl_Obj* valuePtr ) + int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, + int index, Tcl_Obj *valuePtr) } # VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above) @@ -701,7 +699,7 @@ declare 5 mac { int FSpSetDefaultDir(FSSpecPtr theSpec) } declare 6 mac { - OSErr FSpFindFolder(short vRefNum, OSType folderType, \ + OSErr FSpFindFolder(short vRefNum, OSType folderType, Boolean createFolder, FSSpec *spec) } declare 7 mac { @@ -713,15 +711,15 @@ declare 7 mac { # however. The first set are from the MoreFiles package. declare 8 mac { - pascal OSErr FSpGetDirectoryIDTcl(CONST FSSpec *spec, long *theDirID, \ + pascal OSErr FSpGetDirectoryIDTcl(CONST FSSpec *spec, long *theDirID, Boolean *isDirectory) } declare 9 mac { - pascal short FSpOpenResFileCompatTcl(CONST FSSpec *spec, \ + pascal short FSpOpenResFileCompatTcl(CONST FSSpec *spec, SignedByte permission) } declare 10 mac { - pascal void FSpCreateResFileCompatTcl(CONST FSSpec *spec, OSType creator, \ + pascal void FSpCreateResFileCompatTcl(CONST FSSpec *spec, OSType creator, OSType fileType, ScriptCode scriptTag) } @@ -732,7 +730,7 @@ declare 11 mac { int FSpLocationFromPath(int length, CONST char *path, FSSpecPtr theSpec) } declare 12 mac { - OSErr FSpPathFromLocation(FSSpecPtr theSpec, int *length, \ + OSErr FSpPathFromLocation(FSSpecPtr theSpec, int *length, Handle *fullPath) } @@ -760,7 +758,7 @@ declare 19 mac { int TclMacTimerExpired(void *timerToken) } declare 20 mac { - int TclMacRegisterResourceFork(short fileRef, Tcl_Obj *tokenPtr, \ + int TclMacRegisterResourceFork(short fileRef, Tcl_Obj *tokenPtr, int insert) } declare 21 mac { @@ -793,11 +791,11 @@ declare 1 win { void TclWinConvertWSAError(DWORD errCode) } declare 2 win { - struct servent * TclWinGetServByName(CONST char *nm, \ + struct servent * TclWinGetServByName(CONST char *nm, CONST char *proto) } declare 3 win { - int TclWinGetSockOpt(SOCKET s, int level, int optname, \ + int TclWinGetSockOpt(SOCKET s, int level, int optname, char FAR * optval, int FAR *optlen) } declare 4 win { @@ -811,7 +809,7 @@ declare 6 win { u_short TclWinNToHS(u_short ns) } declare 7 win { - int TclWinSetSockOpt(SOCKET s, int level, int optname, \ + int TclWinSetSockOpt(SOCKET s, int level, int optname, CONST char FAR * optval, int optlen) } declare 8 win { @@ -834,15 +832,15 @@ declare 12 win { int TclpCloseFile(TclFile file) } declare 13 win { - Tcl_Channel TclpCreateCommandChannel(TclFile readFile, \ + Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) } declare 14 win { int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } declare 15 win { - int TclpCreateProcess(Tcl_Interp *interp, int argc, CONST char **argv, \ - TclFile inputFile, TclFile outputFile, TclFile errorFile, \ + int TclpCreateProcess(Tcl_Interp *interp, int argc, CONST char **argv, + TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr) } # Signature changed in 8.1: @@ -902,21 +900,20 @@ declare 1 unix { int TclpCloseFile(TclFile file) } declare 2 unix { - Tcl_Channel TclpCreateCommandChannel(TclFile readFile, \ + Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr) } declare 3 unix { int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe) } declare 4 unix { - int TclpCreateProcess(Tcl_Interp *interp, int argc, CONST char **argv, \ - TclFile inputFile, TclFile outputFile, TclFile errorFile, \ + int TclpCreateProcess(Tcl_Interp *interp, int argc, CONST char **argv, + TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr) } # Signature changed in 8.1: # declare 5 unix { -# TclFile TclpCreateTempFile(char *contents, -# Tcl_DString *namePtr) +# TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr) # } declare 6 unix { TclFile TclpMakeFile(Tcl_Channel channel, int direction) diff --git a/generic/tclInt.h b/generic/tclInt.h index dcb573c..209991d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.79 2002/02/10 20:36:34 kennykb Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.80 2002/02/15 14:28:49 dkf Exp $ */ #ifndef _TCLINT @@ -28,12 +28,12 @@ * needed by stdlib.h in some configurations. */ -#include <stdio.h> - #ifndef _TCL #include "tcl.h" #endif +#include <stdio.h> + #include <ctype.h> #ifdef NO_LIMITS_H # include "../compat/limits.h" @@ -1190,7 +1190,7 @@ typedef struct Interp { /* * Information related to procedures and variables. See tclProc.c - * and tclvar.c for usage. + * and tclVar.c for usage. */ int numLevels; /* Keeps track of how many nested calls to @@ -1595,6 +1595,9 @@ extern Tcl_ObjType tclStringType; extern Tcl_ObjType tclArraySearchType; extern Tcl_ObjType tclIndexType; extern Tcl_ObjType tclNsNameType; +#ifndef TCL_WIDE_INT_IS_LONG +extern Tcl_ObjType tclWideIntType; +#endif /* * Variables denoting the hash key types defined in the core. @@ -1790,7 +1793,7 @@ EXTERN int TclOpenFileChannelInsertProc _ANSI_ARGS_(( EXTERN int TclpObjAccess _ANSI_ARGS_((Tcl_Obj *filename, int mode)); EXTERN int TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr, - struct stat *buf)); + Tcl_StatBuf *buf)); EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size)); EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void)); EXTERN Tcl_Obj* TclpTempFileName _ANSI_ARGS_((void)); @@ -1859,7 +1862,7 @@ EXTERN Tcl_Obj* TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj *toPtr)); EXTERN int TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr)); EXTERN Tcl_Obj* TclFileDirname _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj*pathPtr)); -EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf)); +EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)); EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *modeString, int permissions)); @@ -1867,8 +1870,7 @@ EXTERN void TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *, format)); EXTERN char * TclpReadlink _ANSI_ARGS_((CONST char *fileName, Tcl_DString *linkPtr)); -EXTERN char * TclpRealloc _ANSI_ARGS_((char *ptr, - unsigned int size)); +EXTERN char * TclpRealloc _ANSI_ARGS_((char *ptr, unsigned int size)); EXTERN void TclpReleaseFile _ANSI_ARGS_((TclFile file)); EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void)); EXTERN void TclpSetVariables _ANSI_ARGS_((Tcl_Interp *interp)); diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 0b39602..3c7359c 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIntDecls.h,v 1.37 2002/01/25 22:01:31 dgp Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.38 2002/02/15 14:28:49 dkf Exp $ */ #ifndef _TCLINTDECLS @@ -494,9 +494,9 @@ EXTERN void TclExpandCodeArray _ANSI_ARGS_((void * envPtr)); /* 165 */ EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void)); /* 166 */ -EXTERN int TclListObjSetElement _ANSI_ARGS_((Tcl_Interp* interp, - Tcl_Obj* listPtr, int index, - Tcl_Obj* valuePtr)); +EXTERN int TclListObjSetElement _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Obj * listPtr, + int index, Tcl_Obj * valuePtr)); /* 167 */ EXTERN void TclSetStartupScriptPath _ANSI_ARGS_(( Tcl_Obj * pathPtr)); @@ -705,7 +705,7 @@ typedef struct TclIntStubs { void * (*tclGetInstructionTable) _ANSI_ARGS_((void)); /* 163 */ void (*tclExpandCodeArray) _ANSI_ARGS_((void * envPtr)); /* 164 */ void (*tclpSetInitialEncodings) _ANSI_ARGS_((void)); /* 165 */ - int (*tclListObjSetElement) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* listPtr, int index, Tcl_Obj* valuePtr)); /* 166 */ + int (*tclListObjSetElement) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj * valuePtr)); /* 166 */ void (*tclSetStartupScriptPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 167 */ Tcl_Obj * (*tclGetStartupScriptPath) _ANSI_ARGS_((void)); /* 168 */ } TclIntStubs; diff --git a/generic/tclInterp.c b/generic/tclInterp.c index da3ab66..b7d07cb 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -9,12 +9,12 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.10 2002/01/17 04:37:33 dgp Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.11 2002/02/15 14:28:49 dkf Exp $ */ -#include <stdio.h> #include "tclInt.h" #include "tclPort.h" +#include <stdio.h> /* * Counter for how many aliases were created (global) diff --git a/generic/tclLink.c b/generic/tclLink.c index 3066557..8d7a3fe 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLink.c,v 1.4 2002/01/25 20:40:55 dgp Exp $ + * RCS: @(#) $Id: tclLink.c,v 1.5 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -26,7 +26,7 @@ typedef struct Link { Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ - char *varName; /* Name of variable (must be global). This + Tcl_Obj *varName; /* Name of variable (must be global). This * is needed during trace callbacks, since * the actual variable may be aliased at * that time via upvar. */ @@ -35,6 +35,7 @@ typedef struct Link { union { int i; double d; + Tcl_WideInt w; } lastValue; /* Last known value of C variable; used to * avoid string conversions. */ int flags; /* Miscellaneous one-bit values; see below @@ -61,8 +62,7 @@ typedef struct Link { static char * LinkTraceProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)); -static char * StringValue _ANSI_ARGS_((Link *linkPtr, - char *buffer)); +static Tcl_Obj * ObjValue _ANSI_ARGS_((Link *linkPtr)); /* *---------------------------------------------------------------------- @@ -96,13 +96,12 @@ Tcl_LinkVar(interp, varName, addr, type) * OR'ed in. */ { Link *linkPtr; - char buffer[TCL_DOUBLE_SPACE]; int code; linkPtr = (Link *) ckalloc(sizeof(Link)); linkPtr->interp = interp; - linkPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1)); - strcpy(linkPtr->varName, varName); + linkPtr->varName = Tcl_NewStringObj(varName, -1); + Tcl_IncrRefCount(linkPtr->varName); linkPtr->addr = addr; linkPtr->type = type & ~TCL_LINK_READ_ONLY; if (type & TCL_LINK_READ_ONLY) { @@ -110,9 +109,9 @@ Tcl_LinkVar(interp, varName, addr, type) } else { linkPtr->flags = 0; } - if (Tcl_SetVar(interp, varName, StringValue(linkPtr, buffer), + if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - ckfree(linkPtr->varName); + Tcl_DecrRefCount(linkPtr->varName); ckfree((char *) linkPtr); return TCL_ERROR; } @@ -120,7 +119,7 @@ Tcl_LinkVar(interp, varName, addr, type) |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); if (code != TCL_OK) { - ckfree(linkPtr->varName); + Tcl_DecrRefCount(linkPtr->varName); ckfree((char *) linkPtr); } return code; @@ -159,7 +158,7 @@ Tcl_UnlinkVar(interp, varName) Tcl_UntraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); - ckfree(linkPtr->varName); + Tcl_DecrRefCount(linkPtr->varName); ckfree((char *) linkPtr); } @@ -188,7 +187,6 @@ Tcl_UpdateLinkedVar(interp, varName) char *varName; /* Name of global variable that is linked. */ { Link *linkPtr; - char buffer[TCL_DOUBLE_SPACE]; int savedFlag; linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY, @@ -198,7 +196,7 @@ Tcl_UpdateLinkedVar(interp, varName) } savedFlag = linkPtr->flags & LINK_BEING_UPDATED; linkPtr->flags |= LINK_BEING_UPDATED; - Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer), + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag; } @@ -233,11 +231,10 @@ LinkTraceProc(clientData, interp, name1, name2, flags) int flags; /* Miscellaneous additional information. */ { Link *linkPtr = (Link *) clientData; - int changed; - char buffer[TCL_DOUBLE_SPACE]; + int changed, valueLength; CONST char *value; char **pp, *result; - Tcl_Obj *objPtr; + Tcl_Obj *objPtr, *valueObj; /* * If the variable is being unset, then just re-create it (with a @@ -246,14 +243,14 @@ LinkTraceProc(clientData, interp, name1, name2, flags) if (flags & TCL_TRACE_UNSETS) { if (flags & TCL_INTERP_DESTROYED) { - ckfree(linkPtr->varName); + Tcl_DecrRefCount(linkPtr->varName); ckfree((char *) linkPtr); } else if (flags & TCL_TRACE_DESTROYED) { - Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer), + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); - Tcl_TraceVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY - |TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - LinkTraceProc, (ClientData) linkPtr); + Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName), + TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES + |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); } return NULL; } @@ -276,21 +273,24 @@ LinkTraceProc(clientData, interp, name1, name2, flags) if (flags & TCL_TRACE_READS) { switch (linkPtr->type) { - case TCL_LINK_INT: - case TCL_LINK_BOOLEAN: - changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i; - break; - case TCL_LINK_DOUBLE: - changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d; - break; - case TCL_LINK_STRING: - changed = 1; - break; - default: - return "internal error: bad linked variable type"; + case TCL_LINK_INT: + case TCL_LINK_BOOLEAN: + changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i; + break; + case TCL_LINK_DOUBLE: + changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d; + break; + case TCL_LINK_WIDE_INT: + changed = *(Tcl_WideInt *)(linkPtr->addr) != linkPtr->lastValue.w; + break; + case TCL_LINK_STRING: + changed = 1; + break; + default: + return "internal error: bad linked variable type"; } if (changed) { - Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer), + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); } return NULL; @@ -306,12 +306,12 @@ LinkTraceProc(clientData, interp, name1, name2, flags) */ if (linkPtr->flags & LINK_READ_ONLY) { - Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer), + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "linked variable is read-only"; } - value = Tcl_GetVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY); - if (value == NULL) { + valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY); + if (valueObj == NULL) { /* * This shouldn't ever happen. */ @@ -324,48 +324,67 @@ LinkTraceProc(clientData, interp, name1, name2, flags) result = NULL; switch (linkPtr->type) { - case TCL_LINK_INT: - if (Tcl_GetInt(interp, value, &linkPtr->lastValue.i) != TCL_OK) { - Tcl_SetObjResult(interp, objPtr); - Tcl_SetVar(interp, linkPtr->varName, - StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY); - result = "variable must have integer value"; - goto end; - } - *(int *)(linkPtr->addr) = linkPtr->lastValue.i; - break; - case TCL_LINK_DOUBLE: - if (Tcl_GetDouble(interp, value, &linkPtr->lastValue.d) - != TCL_OK) { - Tcl_SetObjResult(interp, objPtr); - Tcl_SetVar(interp, linkPtr->varName, - StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY); - result = "variable must have real value"; - goto end; - } - *(double *)(linkPtr->addr) = linkPtr->lastValue.d; - break; - case TCL_LINK_BOOLEAN: - if (Tcl_GetBoolean(interp, value, &linkPtr->lastValue.i) - != TCL_OK) { - Tcl_SetObjResult(interp, objPtr); - Tcl_SetVar(interp, linkPtr->varName, - StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY); - result = "variable must have boolean value"; - goto end; - } - *(int *)(linkPtr->addr) = linkPtr->lastValue.i; - break; - case TCL_LINK_STRING: - pp = (char **)(linkPtr->addr); - if (*pp != NULL) { - ckfree(*pp); - } - *pp = (char *) ckalloc((unsigned) (strlen(value) + 1)); - strcpy(*pp, value); - break; - default: - result = "internal error: bad linked variable type"; + case TCL_LINK_INT: + if (Tcl_GetIntFromObj(interp, valueObj, &linkPtr->lastValue.i) + != TCL_OK) { + Tcl_SetObjResult(interp, objPtr); + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + result = "variable must have integer value"; + goto end; + } + *(int *)(linkPtr->addr) = linkPtr->lastValue.i; + break; + + case TCL_LINK_WIDE_INT: + if (Tcl_GetWideIntFromObj(interp, valueObj, &linkPtr->lastValue.w) + != TCL_OK) { + Tcl_SetObjResult(interp, objPtr); + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + result = "variable must have integer value"; + goto end; + } + *(Tcl_WideInt *)(linkPtr->addr) = linkPtr->lastValue.w; + break; + + case TCL_LINK_DOUBLE: + if (Tcl_GetDoubleFromObj(interp, valueObj, &linkPtr->lastValue.d) + != TCL_OK) { + Tcl_SetObjResult(interp, objPtr); + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + result = "variable must have real value"; + goto end; + } + *(double *)(linkPtr->addr) = linkPtr->lastValue.d; + break; + + case TCL_LINK_BOOLEAN: + if (Tcl_GetBooleanFromObj(interp, valueObj, &linkPtr->lastValue.i) + != TCL_OK) { + Tcl_SetObjResult(interp, objPtr); + Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), + TCL_GLOBAL_ONLY); + result = "variable must have boolean value"; + goto end; + } + *(int *)(linkPtr->addr) = linkPtr->lastValue.i; + break; + + case TCL_LINK_STRING: + value = Tcl_GetStringFromObj(valueObj, &valueLength); + valueLength++; + pp = (char **)(linkPtr->addr); + if (*pp != NULL) { + ckfree(*pp); + } + *pp = (char *) ckalloc((unsigned) valueLength); + memcpy(*pp, value, (unsigned) valueLength); + break; + + default: + return "internal error: bad linked variable type"; } end: Tcl_DecrRefCount(objPtr); @@ -375,13 +394,13 @@ LinkTraceProc(clientData, interp, name1, name2, flags) /* *---------------------------------------------------------------------- * - * StringValue -- + * ObjValue -- * - * Converts the value of a C variable to a string for use in a + * Converts the value of a C variable to a Tcl_Obj* for use in a * Tcl variable to which it is linked. * * Results: - * The return value is a pointer to a string that represents + * The return value is a pointer to a Tcl_Obj that represents * the value of the C variable given by linkPtr. * * Side effects: @@ -390,42 +409,37 @@ LinkTraceProc(clientData, interp, name1, name2, flags) *---------------------------------------------------------------------- */ -static char * -StringValue(linkPtr, buffer) +static Tcl_Obj * +ObjValue(linkPtr) Link *linkPtr; /* Structure describing linked variable. */ - char *buffer; /* Small buffer to use for converting - * values. Must have TCL_DOUBLE_SPACE - * bytes or more. */ { char *p; switch (linkPtr->type) { - case TCL_LINK_INT: - linkPtr->lastValue.i = *(int *)(linkPtr->addr); - TclFormatInt(buffer, linkPtr->lastValue.i); - return buffer; - case TCL_LINK_DOUBLE: - linkPtr->lastValue.d = *(double *)(linkPtr->addr); - Tcl_PrintDouble((Tcl_Interp *) NULL, linkPtr->lastValue.d, buffer); - return buffer; - case TCL_LINK_BOOLEAN: - linkPtr->lastValue.i = *(int *)(linkPtr->addr); - if (linkPtr->lastValue.i != 0) { - return "1"; - } - return "0"; - case TCL_LINK_STRING: - p = *(char **)(linkPtr->addr); - if (p == NULL) { - return "NULL"; - } - return p; - } + case TCL_LINK_INT: + linkPtr->lastValue.i = *(int *)(linkPtr->addr); + return Tcl_NewIntObj(linkPtr->lastValue.i); + case TCL_LINK_WIDE_INT: + linkPtr->lastValue.w = *(Tcl_WideInt *)(linkPtr->addr); + return Tcl_NewWideIntObj(linkPtr->lastValue.w); + case TCL_LINK_DOUBLE: + linkPtr->lastValue.d = *(double *)(linkPtr->addr); + return Tcl_NewDoubleObj(linkPtr->lastValue.d); + case TCL_LINK_BOOLEAN: + linkPtr->lastValue.i = *(int *)(linkPtr->addr); + return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0); + case TCL_LINK_STRING: + p = *(char **)(linkPtr->addr); + if (p == NULL) { + return Tcl_NewStringObj("NULL", 4); + } + return Tcl_NewStringObj(p, -1); /* * This code only gets executed if the link type is unknown * (shouldn't ever happen). */ - - return "??"; + default: + return Tcl_NewStringObj("??", 2); + } } diff --git a/generic/tclObj.c b/generic/tclObj.c index c895237..c5f7f12 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.28 2002/01/25 21:36:09 dgp Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.29 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -63,6 +63,11 @@ static int SetIntFromAny _ANSI_ARGS_((Tcl_Interp *interp, static void UpdateStringOfBoolean _ANSI_ARGS_((Tcl_Obj *objPtr)); static void UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr)); static void UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr)); +#ifndef TCL_WIDE_INT_IS_LONG +static int SetWideIntFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static void UpdateStringOfWideInt _ANSI_ARGS_((Tcl_Obj *objPtr)); +#endif /* * Prototypes for the array hash key methods. @@ -121,6 +126,16 @@ Tcl_ObjType tclIntType = { SetIntFromAny /* setFromAnyProc */ }; +#ifndef TCL_WIDE_INT_IS_LONG +Tcl_ObjType tclWideIntType = { + "wideInt", /* name */ + (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */ + (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */ + UpdateStringOfWideInt, /* updateStringProc */ + SetWideIntFromAny /* setFromAnyProc */ +}; +#endif + /* * The structure below defines the Tcl obj hash key type. */ @@ -218,6 +233,9 @@ TclInitObjSubsystem() Tcl_RegisterObjType(&tclDoubleType); Tcl_RegisterObjType(&tclEndOffsetType); Tcl_RegisterObjType(&tclIntType); +#ifndef TCL_WIDE_INT_IS_LONG + Tcl_RegisterObjType(&tclWideIntType); +#endif Tcl_RegisterObjType(&tclStringType); Tcl_RegisterObjType(&tclListType); Tcl_RegisterObjType(&tclByteCodeType); @@ -826,11 +844,11 @@ Tcl_GetString(objPtr) char * Tcl_GetStringFromObj(objPtr, lengthPtr) - register Tcl_Obj *objPtr; /* Object whose string rep byte pointer - * should be returned. */ - register int *lengthPtr; /* If non-NULL, the location where the - * string rep's byte array length should be - * stored. If NULL, no length is stored. */ + register Tcl_Obj *objPtr; /* Object whose string rep byte pointer should + * be returned. */ + register int *lengthPtr; /* If non-NULL, the location where the string + * rep's byte array length should * be stored. + * If NULL, no length is stored. */ { if (objPtr->bytes == NULL) { if (objPtr->typePtr->updateStringProc == NULL) { @@ -1092,7 +1110,6 @@ SetBooleanFromAny(interp, objPtr) char lowerCase[10]; int newBool, length; register int i; - double dbl; /* * Get the string representation. Make it up-to-date if necessary. @@ -1148,6 +1165,24 @@ SetBooleanFromAny(interp, objPtr) goto badBoolean; } } else { + double dbl; +#ifndef TCL_WIDE_INT_IS_LONG + Tcl_WideInt wide = strtoll(string, &end, 0); + if (end != string) { + /* + * Make sure the string has no garbage after the end of + * the wide int. + */ + while ((end < (string+length)) + && isspace(UCHAR(*end))) { /* INTL: ISO only */ + end++; + } + if (end == (string+length)) { + newBool = (wide != Tcl_LongAsWide(0)); + goto goodBoolean; + } + } +#endif /* * Still might be a string containing the characters representing an * int or double that wasn't handled above. This would be a string @@ -1182,6 +1217,7 @@ SetBooleanFromAny(interp, objPtr) * Tcl_GetStringFromObj, to use that old internalRep. */ + goodBoolean: if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) { oldTypePtr->freeIntRepProc(objPtr); } @@ -2060,6 +2096,380 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr) /* *---------------------------------------------------------------------- * + * SetWideIntFromAny -- + * + * Attempt to generate an integer internal form for the Tcl object + * "objPtr". + * + * Results: + * The return value is a standard object Tcl result. If an error occurs + * during conversion, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + * Side effects: + * If no error occurs, an int is stored as "objPtr"s internal + * representation. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_WIDE_INT_IS_LONG +static int +SetWideIntFromAny(interp, objPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + register Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_ObjType *oldTypePtr = objPtr->typePtr; + char *string, *end; + int length; + register char *p; + Tcl_WideInt newWide; + + /* + * Get the string representation. Make it up-to-date if necessary. + */ + + string = Tcl_GetStringFromObj(objPtr, &length); + + /* + * Now parse "objPtr"s string as an int. We use an implementation here + * that doesn't report errors in interp if interp is NULL. Note: use + * strtoull instead of strtoll for integer conversions to allow full-size + * unsigned numbers, but don't depend on strtoull to handle sign + * characters; it won't in some implementations. + */ + + errno = 0; + for (p = string; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */ + /* Empty loop body. */ + } + if (*p == '-') { + p++; + newWide = -((Tcl_WideInt)strtoull(p, &end, 0)); + } else if (*p == '+') { + p++; + newWide = strtoull(p, &end, 0); + } else { + newWide = strtoull(p, &end, 0); + } + if (end == p) { + badInteger: + if (interp != NULL) { + /* + * Must copy string before resetting the result in case a caller + * is trying to convert the interpreter's result to an int. + */ + + char buf[100]; + sprintf(buf, "expected integer but got \"%.50s\"", string); + Tcl_ResetResult(interp); + Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1); + TclCheckBadOctal(interp, string); + } + return TCL_ERROR; + } + if (errno == ERANGE) { + if (interp != NULL) { + char *s = "integer value too large to represent"; + Tcl_ResetResult(interp); + Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1); + Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL); + } + return TCL_ERROR; + } + + /* + * Make sure that the string has no garbage after the end of the int. + */ + + while ((end < (string+length)) + && isspace(UCHAR(*end))) { /* INTL: ISO space. */ + end++; + } + if (end != (string+length)) { + goto badInteger; + } + + /* + * The conversion to int succeeded. Free the old internalRep before + * setting the new one. We do this as late as possible to allow the + * conversion code, in particular Tcl_GetStringFromObj, to use that old + * internalRep. + */ + + if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) { + oldTypePtr->freeIntRepProc(objPtr); + } + + objPtr->internalRep.wideValue = newWide; + objPtr->typePtr = &tclWideIntType; + return TCL_OK; +} +#endif + +/* + *---------------------------------------------------------------------- + * + * UpdateStringOfWideInt -- + * + * Update the string representation for a wide integer object. + * Note: This procedure does not free an existing old string rep + * so storage will be lost if this has not already been done. + * + * Results: + * None. + * + * Side effects: + * The object's string is set to a valid string that results from + * the wideInt-to-string conversion. + * + *---------------------------------------------------------------------- + */ + +#ifndef TCL_WIDE_INT_IS_LONG +static void +UpdateStringOfWideInt(objPtr) + register Tcl_Obj *objPtr; /* Int object whose string rep to update. */ +{ + char buffer[TCL_INTEGER_SPACE+2]; + register unsigned len; + register Tcl_WideInt wideVal = objPtr->internalRep.wideValue; + + sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal); + len = strlen(buffer); + objPtr->bytes = ckalloc((unsigned) len + 1); + memcpy(objPtr->bytes, buffer, len + 1); + objPtr->length = len; +} +#endif /* TCL_WIDE_INT_IS_LONG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_NewWideIntObj -- + * + * If a client is compiled with TCL_MEM_DEBUG defined, calls to + * Tcl_NewWideIntObj to create a new 64-bit integer object end up calling + * the debugging procedure Tcl_DbNewWideIntObj instead. + * + * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined, + * calls to Tcl_NewWideIntObj result in a call to one of the two + * Tcl_NewWideIntObj implementations below. We provide two implementations + * so that the Tcl core can be compiled to do memory debugging of the + * core even if a client does not request it for itself. + * + * Results: + * The newly created object is returned. This object will have an + * invalid string representation. The returned object has ref count 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#ifdef TCL_MEM_DEBUG +#undef Tcl_NewWideIntObj + +Tcl_Obj * +Tcl_NewWideIntObj(wideValue) + register Tcl_WideInt wideValue; /* Wide integer used to initialize + * the new object. */ +{ + return Tcl_DbNewWideIntObj(wideValue, "unknown", 0); +} + +#else /* if not TCL_MEM_DEBUG */ + +Tcl_Obj * +Tcl_NewWideIntObj(wideValue) + register Tcl_WideInt wideValue; /* Wide integer used to initialize + * the new object. */ +{ +#ifdef TCL_WIDE_INT_IS_LONG + return Tcl_NewLongObj(wideValue); +#else + register Tcl_Obj *objPtr; + + TclNewObj(objPtr); + objPtr->bytes = NULL; + + objPtr->internalRep.wideValue = wideValue; + objPtr->typePtr = &tclWideIntType; + return objPtr; +#endif /* TCL_WIDE_INT_IS_LONG */ +} +#endif /* if TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_DbNewWideIntObj -- + * + * If a client is compiled with TCL_MEM_DEBUG defined, calls to + * Tcl_NewWideIntObj to create new wide integer end up calling + * the debugging procedure Tcl_DbNewWideIntObj instead. We + * provide two implementations of Tcl_DbNewWideIntObj so that + * whether the Tcl core is compiled to do memory debugging of the + * core is independent of whether a client requests debugging for + * itself. + * + * When the core is compiled with TCL_MEM_DEBUG defined, + * Tcl_DbNewWideIntObj calls Tcl_DbCkalloc directly with the file + * name and line number from its caller. This simplifies + * debugging since then the checkmem command will report the + * caller's file name and line number when reporting objects that + * haven't been freed. + * + * Otherwise, when the core is compiled without TCL_MEM_DEBUG defined, + * this procedure just returns the result of calling Tcl_NewWideIntObj. + * + * Results: + * The newly created wide integer object is returned. This object + * will have an invalid string representation. The returned object has + * ref count 0. + * + * Side effects: + * Allocates memory. + * + *---------------------------------------------------------------------- + */ + +#ifdef TCL_MEM_DEBUG + +Tcl_Obj * +Tcl_DbNewWideIntObj(wideValue, file, line) + register Tcl_WideInt wideValue; /* Wide integer used to initialize + * the new object. */ + CONST char *file; /* The name of the source file + * calling this procedure; used for + * debugging. */ + int line; /* Line number in the source file; + * used for debugging. */ +{ +#ifdef TCL_WIDE_INT_IS_LONG + return Tcl_DbNewLongObj(wideValue, file, line); +#else + register Tcl_Obj *objPtr; + + TclDbNewObj(objPtr, file, line); + objPtr->bytes = NULL; + + objPtr->internalRep.wideValue = wideValue; + objPtr->typePtr = &tclWideIntType; + return objPtr; +#endif +} + +#else /* if not TCL_MEM_DEBUG */ + +Tcl_Obj * +Tcl_DbNewWideIntObj(wideValue, file, line) + register Tcl_WideInt wideValue; /* Long integer used to initialize + * the new object. */ + CONST char *file; /* The name of the source file + * calling this procedure; used for + * debugging. */ + int line; /* Line number in the source file; + * used for debugging. */ +{ + return Tcl_NewWideIntObj(wideValue); +} +#endif /* TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetWideIntObj -- + * + * Modify an object to be a wide integer object and to have the + * specified wide integer value. + * + * Results: + * None. + * + * Side effects: + * The object's old string rep, if any, is freed. Also, any old + * internal rep is freed. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SetWideIntObj(objPtr, wideValue) + register Tcl_Obj *objPtr; /* Object w. internal rep to init. */ + register Tcl_WideInt wideValue; /* Wide integer used to initialize + * the object's value. */ +{ +#ifdef TCL_WIDE_INT_IS_LONG + Tcl_SetLongObj(objPtr, wideValue); +#else + register Tcl_ObjType *oldTypePtr = objPtr->typePtr; + + if (Tcl_IsShared(objPtr)) { + panic("Tcl_SetWideIntObj called with shared object"); + } + + if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) { + oldTypePtr->freeIntRepProc(objPtr); + } + + objPtr->internalRep.wideValue = wideValue; + objPtr->typePtr = &tclWideIntType; + Tcl_InvalidateStringRep(objPtr); +#endif +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetWideIntFromObj -- + * + * Attempt to return a wide integer from the Tcl object "objPtr". If + * the object is not already a wide int object, an attempt will be made + * to convert it to one. + * + * Results: + * The return value is a standard Tcl object result. If an error occurs + * during conversion, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + * Side effects: + * If the object is not already an int object, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + register Tcl_Obj *objPtr; /* Object from which to get a wide int. */ + register Tcl_WideInt *wideIntPtr; /* Place to store resulting long. */ +{ +#ifdef TCL_WIDE_INT_IS_LONG + /* + * Next line is type-safe because we only do this when long = Tcl_WideInt + */ + return Tcl_GetLongFromObj(interp, objPtr, wideIntPtr); +#else + register int result; + + if (objPtr->typePtr == &tclWideIntType) { + *wideIntPtr = objPtr->internalRep.wideValue; + return TCL_OK; + } + result = SetWideIntFromAny(interp, objPtr); + if (result == TCL_OK) { + *wideIntPtr = objPtr->internalRep.wideValue; + } + return result; +#endif +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DbIncrRefCount -- * * This procedure is normally called when debugging: i.e., when diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c index defdecf..f7d0428 100644 --- a/generic/tclParseExpr.c +++ b/generic/tclParseExpr.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParseExpr.c,v 1.11 2001/12/06 10:59:17 dkf Exp $ + * RCS: @(#) $Id: tclParseExpr.c,v 1.12 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -1579,7 +1579,11 @@ GetLexeme(infoPtr) startsWithDigit = isdigit(UCHAR(c)); /* INTL: digit */ if (startsWithDigit && TclLooksLikeInt(src, -1)) { errno = 0; +#ifdef TCL_WIDE_INT_IS_LONG (void) strtoul(src, &termPtr, 0); +#else + (void) strtoull(src, &termPtr, 0); +#endif if (errno == ERANGE) { if (interp != NULL) { char *s = "integer value too large to represent"; diff --git a/generic/tclPipe.c b/generic/tclPipe.c index dcfabdf..5365047 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclPipe.c,v 1.5 2002/01/25 20:40:55 dgp Exp $ + * RCS: @(#) $Id: tclPipe.c,v 1.6 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -372,7 +372,7 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan) int count; Tcl_Obj *objPtr; - Tcl_Seek(errorChan, 0L, SEEK_SET); + Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET); objPtr = Tcl_NewObj(); count = Tcl_ReadChars(errorChan, objPtr, -1, 0); if (count < 0) { diff --git a/generic/tclPort.h b/generic/tclPort.h index 70281a2..930ae1d 100644 --- a/generic/tclPort.h +++ b/generic/tclPort.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclPort.h,v 1.5 1999/05/25 01:00:27 stanton Exp $ + * RCS: @(#) $Id: tclPort.h,v 1.6 2002/02/15 14:28:49 dkf Exp $ */ #ifndef _TCLPORT @@ -22,10 +22,22 @@ # include "../win/tclWinPort.h" #else # if defined(MAC_TCL) -# include "tclMacPort.h" -# else -# include "../unix/tclUnixPort.h" -# endif +# include "tclMacPort.h" +# else +# include "../unix/tclUnixPort.h" +# endif #endif +#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(LLONG_MIN) +# ifdef LLONG_BIT +# define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1))) +# else +/* Assume we're on a system with a 64-bit 'long long' type */ +# define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63)) +# endif +/* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */ +# define LLONG_MAX (~LLONG_MIN) +#endif + + #endif /* _TCLPORT */ diff --git a/generic/tclScan.c b/generic/tclScan.c index d631116..9eb60e7 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -8,10 +8,14 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclScan.c,v 1.10 2002/02/08 09:33:24 hobbs Exp $ + * RCS: @(#) $Id: tclScan.c,v 1.11 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" +/* + * For strtoll() and strtoull() declarations on some platforms... + */ +#include "tclPort.h" /* * Flag values used by Tcl_ScanObjCmd. @@ -29,6 +33,7 @@ #define SCAN_PTOK 0x100 /* Decimal point is allowed. */ #define SCAN_EXPOK 0x200 /* An exponent is allowed. */ +#define SCAN_LONGER 0x400 /* Asked for a wide value. */ /* * The following structure contains the information associated with @@ -270,6 +275,7 @@ ValidateFormat(interp, format, numVars, totalSubs) int staticAssign[STATIC_LIST_SIZE]; int *nassign = staticAssign; int objIndex, xpgSize, nspace = STATIC_LIST_SIZE; + char buf[TCL_UTF_MAX+1]; /* * Initialize an array that records the number of times a variable @@ -359,10 +365,16 @@ ValidateFormat(interp, format, numVars, totalSubs) } /* - * Ignore size specifier. + * Handle any size specifier. */ - if ((ch == 'l') || (ch == 'L') || (ch == 'h')) { + switch (ch) { + case 'l': + case 'L': +#ifndef TCL_WIDE_INT_IS_LONG + flags |= SCAN_LONGER; +#endif + case 'h': format += Tcl_UtfToUniChar(format, &ch); } @@ -375,24 +387,45 @@ ValidateFormat(interp, format, numVars, totalSubs) */ switch (ch) { + case 'c': + if (flags & SCAN_WIDTH) { + Tcl_SetResult(interp, + "field width may not be specified in %c conversion", + TCL_STATIC); + goto error; + } + /* + * Fall through! + */ case 'n': + case 's': + if (flags & SCAN_LONGER) { + invalidLonger: + buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "'l' modifier may not be specified in %", buf, + " conversion", NULL); + goto error; + } + /* + * Fall through! + */ case 'd': + case 'e': + case 'f': + case 'g': case 'i': case 'o': - case 'x': case 'u': - case 'f': - case 'e': - case 'g': - case 's': - break; - case 'c': - if (flags & SCAN_WIDTH) { - Tcl_SetResult(interp, "field width may not be specified in %c conversion", TCL_STATIC); - goto error; - } - break; + case 'x': + break; + /* + * Bracket terms need special checking + */ case '[': + if (flags & SCAN_LONGER) { + goto invalidLonger; + } if (*format == '\0') { goto badSet; } @@ -547,6 +580,10 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) int underflow = 0; size_t width; long (*fn)() = NULL; +#ifndef TCL_WIDE_INT_IS_LONG + Tcl_WideInt (*lfn)() = NULL; + Tcl_WideInt wideValue; +#endif Tcl_UniChar ch, sch; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; @@ -661,10 +698,16 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) } /* - * Ignore size specifier. + * Handle any size specifier. */ - if ((ch == 'l') || (ch == 'L') || (ch == 'h')) { + switch (ch) { + case 'l': + case 'L': +#ifndef TCL_WIDE_INT_IS_LONG + flags |= SCAN_LONGER; +#endif + case 'h': format += Tcl_UtfToUniChar(format, &ch); } @@ -686,27 +729,42 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) op = 'i'; base = 10; fn = (long (*)())strtol; +#ifndef TCL_WIDE_INT_IS_LONG + lfn = (Tcl_WideInt (*)())strtoll; +#endif break; case 'i': op = 'i'; base = 0; fn = (long (*)())strtol; +#ifndef TCL_WIDE_INT_IS_LONG + lfn = (Tcl_WideInt (*)())strtoll; +#endif break; case 'o': op = 'i'; base = 8; fn = (long (*)())strtoul; +#ifndef TCL_WIDE_INT_IS_LONG + lfn = (Tcl_WideInt (*)())strtoull; +#endif break; case 'x': op = 'i'; base = 16; fn = (long (*)())strtoul; +#ifndef TCL_WIDE_INT_IS_LONG + lfn = (Tcl_WideInt (*)())strtoull; +#endif break; case 'u': op = 'i'; base = 10; flags |= SCAN_UNSIGNED; fn = (long (*)())strtoul; +#ifndef TCL_WIDE_INT_IS_LONG + lfn = (Tcl_WideInt (*)())strtoull; +#endif break; case 'f': @@ -962,17 +1020,33 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) if (!(flags & SCAN_SUPPRESS)) { *end = '\0'; - value = (long) (*fn)(buf, NULL, base); - if ((flags & SCAN_UNSIGNED) && (value < 0)) { - sprintf(buf, "%lu", value); /* INTL: ISO digit */ - objPtr = Tcl_NewStringObj(buf, -1); +#ifndef TCL_WIDE_INT_IS_LONG + if (flags & SCAN_LONGER) { + wideValue = (Tcl_WideInt) (*lfn)(buf, NULL, base); + if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { + /* INTL: ISO digit */ + sprintf(buf, "%" TCL_LL_MODIFIER "u", + (Tcl_WideUInt)wideValue); + objPtr = Tcl_NewStringObj(buf, -1); + } else { + objPtr = Tcl_NewWideIntObj(wideValue); + } } else { - if ((unsigned long) value > UINT_MAX) { - objPtr = Tcl_NewLongObj(value); +#endif /* !TCL_WIDE_INT_IS_LONG */ + value = (long) (*fn)(buf, NULL, base); + if ((flags & SCAN_UNSIGNED) && (value < 0)) { + sprintf(buf, "%lu", value); /* INTL: ISO digit */ + objPtr = Tcl_NewStringObj(buf, -1); } else { - objPtr = Tcl_NewIntObj(value); + if ((unsigned long) value > UINT_MAX) { + objPtr = Tcl_NewLongObj(value); + } else { + objPtr = Tcl_NewIntObj(value); + } } +#ifndef TCL_WIDE_INT_IS_LONG } +#endif Tcl_IncrRefCount(objPtr); objs[objIndex++] = objPtr; } @@ -987,6 +1061,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) if ((width == 0) || (width > sizeof(buf) - 1)) { width = sizeof(buf) - 1; } + flags &= ~SCAN_LONGER; flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK; for (end = buf; width > 0; width--) { switch (*string) { diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 7285dac..0ece7d5 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.67 2002/02/10 20:36:34 kennykb Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.68 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -622,7 +622,7 @@ TclStubs tclStubs = { Tcl_ResetResult, /* 217 */ Tcl_ScanElement, /* 218 */ Tcl_ScanCountedElement, /* 219 */ - Tcl_Seek, /* 220 */ + Tcl_SeekOld, /* 220 */ Tcl_ServiceAll, /* 221 */ Tcl_ServiceEvent, /* 222 */ Tcl_SetAssocData, /* 223 */ @@ -648,7 +648,7 @@ TclStubs tclStubs = { Tcl_SplitPath, /* 243 */ Tcl_StaticPackage, /* 244 */ Tcl_StringMatch, /* 245 */ - Tcl_Tell, /* 246 */ + Tcl_TellOld, /* 246 */ Tcl_TraceVar, /* 247 */ Tcl_TraceVar2, /* 248 */ Tcl_TranslateFileName, /* 249 */ @@ -888,6 +888,13 @@ TclStubs tclStubs = { Tcl_CreateObjTrace, /* 483 */ Tcl_GetCommandInfoFromToken, /* 484 */ Tcl_SetCommandInfoFromToken, /* 485 */ + Tcl_DbNewWideIntObj, /* 486 */ + Tcl_GetWideIntFromObj, /* 487 */ + Tcl_NewWideIntObj, /* 488 */ + Tcl_SetWideIntObj, /* 489 */ + Tcl_AllocStatBuf, /* 490 */ + Tcl_Seek, /* 491 */ + Tcl_Tell, /* 492 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index a8635bd..7da18fd 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTest.c,v 1.43 2002/02/10 20:36:34 kennykb Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.44 2002/02/15 14:28:49 dkf Exp $ */ #define TCL_TEST @@ -341,7 +341,7 @@ static void TestReport _ANSI_ARGS_((CONST char* cmd, Tcl_Obj* arg1, Tcl_Obj* arg static Tcl_Obj *TestReportGetNativePath(Tcl_Obj* pathObjPtr); static int TestReportStat _ANSI_ARGS_ ((Tcl_Obj *path, - struct stat *buf)); + Tcl_StatBuf *buf)); static int TestReportAccess _ANSI_ARGS_ ((Tcl_Obj *path, int mode)); static Tcl_Channel TestReportOpenFileChannel _ANSI_ARGS_ (( @@ -353,7 +353,7 @@ static int TestReportMatchInDirectory _ANSI_ARGS_ (( Tcl_GlobTypeData *types)); static int TestReportChdir _ANSI_ARGS_ ((Tcl_Obj *dirName)); static int TestReportLstat _ANSI_ARGS_ ((Tcl_Obj *path, - struct stat *buf)); + Tcl_StatBuf *buf)); static int TestReportCopyFile _ANSI_ARGS_ ((Tcl_Obj *src, Tcl_Obj *dst)); static int TestReportDeleteFile _ANSI_ARGS_ ((Tcl_Obj *path)); @@ -2122,22 +2122,31 @@ TestlinkCmd(dummy, interp, argc, argv) static int intVar = 43; static int boolVar = 4; static double realVar = 1.23; + static Tcl_WideInt wideVar = Tcl_LongAsWide(79); static char *stringVar = NULL; static int created = 0; - char buffer[TCL_DOUBLE_SPACE]; + char buffer[2*TCL_DOUBLE_SPACE]; int writable, flag; + Tcl_Obj *tmp; if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option ?arg arg arg?\"", (char *) NULL); + " option ?arg arg arg arg arg?\"", (char *) NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { + if (argc != 7) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " ", argv[1], + " intRO realRO boolRO stringRO wideRO\"", (char *) NULL); + return TCL_ERROR; + } if (created) { Tcl_UnlinkVar(interp, "int"); Tcl_UnlinkVar(interp, "real"); Tcl_UnlinkVar(interp, "bool"); Tcl_UnlinkVar(interp, "string"); + Tcl_UnlinkVar(interp, "wide"); } created = 1; if (Tcl_GetBoolean(interp, argv[2], &writable) != TCL_OK) { @@ -2172,11 +2181,20 @@ TestlinkCmd(dummy, interp, argc, argv) TCL_LINK_STRING | flag) != TCL_OK) { return TCL_ERROR; } + if (Tcl_GetBoolean(interp, argv[6], &writable) != TCL_OK) { + return TCL_ERROR; + } + flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY; + if (Tcl_LinkVar(interp, "wide", (char *) &wideVar, + TCL_LINK_WIDE_INT | flag) != TCL_OK) { + return TCL_ERROR; + } } else if (strcmp(argv[1], "delete") == 0) { Tcl_UnlinkVar(interp, "int"); Tcl_UnlinkVar(interp, "real"); Tcl_UnlinkVar(interp, "bool"); Tcl_UnlinkVar(interp, "string"); + Tcl_UnlinkVar(interp, "wide"); created = 0; } else if (strcmp(argv[1], "get") == 0) { TclFormatInt(buffer, intVar); @@ -2186,11 +2204,18 @@ TestlinkCmd(dummy, interp, argc, argv) TclFormatInt(buffer, boolVar); Tcl_AppendElement(interp, buffer); Tcl_AppendElement(interp, (stringVar == NULL) ? "-" : stringVar); + /* + * Wide ints only have an object-based interface. + */ + tmp = Tcl_NewWideIntObj(wideVar); + Tcl_AppendElement(interp, Tcl_GetString(tmp)); + Tcl_DecrRefCount(tmp); } else if (strcmp(argv[1], "set") == 0) { - if (argc != 6) { + if (argc != 7) { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " ", argv[1], - "intValue realValue boolValue stringValue\"", (char *) NULL); + argv[0], " ", argv[1], + " intValue realValue boolValue stringValue wideValue\"", + (char *) NULL); return TCL_ERROR; } if (argv[2][0] != 0) { @@ -2219,11 +2244,20 @@ TestlinkCmd(dummy, interp, argc, argv) strcpy(stringVar, argv[5]); } } + if (argv[6][0] != 0) { + tmp = Tcl_NewStringObj(argv[6], -1); + if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { + Tcl_DecrRefCount(tmp); + return TCL_ERROR; + } + Tcl_DecrRefCount(tmp); + } } else if (strcmp(argv[1], "update") == 0) { - if (argc != 6) { + if (argc != 7) { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " ", argv[1], - "intValue realValue boolValue stringValue\"", (char *) NULL); + argv[0], " ", argv[1], + "intValue realValue boolValue stringValue wideValue\"", + (char *) NULL); return TCL_ERROR; } if (argv[2][0] != 0) { @@ -2256,6 +2290,15 @@ TestlinkCmd(dummy, interp, argc, argv) } Tcl_UpdateLinkedVar(interp, "string"); } + if (argv[6][0] != 0) { + tmp = Tcl_NewStringObj(argv[6], -1); + if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { + Tcl_DecrRefCount(tmp); + return TCL_ERROR; + } + Tcl_DecrRefCount(tmp); + Tcl_UpdateLinkedVar(interp, "wide"); + } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": should be create, delete, get, set, or update", @@ -2404,8 +2447,16 @@ TestMathFunc2(clientData, interp, args, resultPtr) resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (args[1].type == TCL_WIDE_INT) { + Tcl_WideInt w0 = Tcl_LongAsWide(i0); + Tcl_WideInt w1 = args[1].wideValue; + + resultPtr->type = TCL_WIDE_INT; + resultPtr->wideValue = ((w0 > w1)? w0 : w1); +#endif } else { - Tcl_SetResult(interp, "T2: wrong type for arg 2", TCL_STATIC); + Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); result = TCL_ERROR; } } else if (args[0].type == TCL_DOUBLE) { @@ -2421,12 +2472,44 @@ TestMathFunc2(clientData, interp, args, resultPtr) resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); +#ifndef TCL_WIDE_INT_IS_LONG + } else if (args[1].type == TCL_WIDE_INT) { + double d1 = Tcl_WideAsDouble(args[1].wideValue); + + resultPtr->type = TCL_DOUBLE; + resultPtr->doubleValue = ((d0 > d1)? d0 : d1); +#endif } else { - Tcl_SetResult(interp, "T2: wrong type for arg 2", TCL_STATIC); + Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); result = TCL_ERROR; } +#ifndef TCL_WIDE_INT_IS_LONG + } else if (args[0].type == TCL_WIDE_INT) { + Tcl_WideInt w0 = args[0].wideValue; + + if (args[1].type == TCL_INT) { + Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue); + + resultPtr->type = TCL_WIDE_INT; + resultPtr->wideValue = ((w0 > w1)? w0 : w1); + } else if (args[1].type == TCL_DOUBLE) { + double d0 = Tcl_WideAsDouble(w0); + double d1 = args[1].doubleValue; + + resultPtr->type = TCL_DOUBLE; + resultPtr->doubleValue = ((d0 > d1)? d0 : d1); + } else if (args[1].type == TCL_WIDE_INT) { + Tcl_WideInt w1 = args[1].wideValue; + + resultPtr->type = TCL_WIDE_INT; + resultPtr->wideValue = ((w0 > w1)? w0 : w1); + } else { + Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); + result = TCL_ERROR; + } +#endif } else { - Tcl_SetResult(interp, "T2: wrong type for arg 1", TCL_STATIC); + Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC); result = TCL_ERROR; } return result; @@ -4240,10 +4323,62 @@ static int PretendTclpStat(path, buf) { int ret; Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); +#ifdef TCL_WIDE_INT_IS_LONG Tcl_IncrRefCount(pathPtr); ret = TclpObjStat(pathPtr, buf); Tcl_DecrRefCount(pathPtr); return ret; +#else /* TCL_WIDE_INT_IS_LONG */ + Tcl_StatBuf realBuf; + Tcl_IncrRefCount(pathPtr); + ret = TclpObjStat(pathPtr, &realBuf); + Tcl_DecrRefCount(pathPtr); + if (ret != -1) { +# define OUT_OF_RANGE(x) \ + (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \ + ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX)) +# define OUT_OF_URANGE(x) \ + (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX) + + /* + * Perform the result-buffer overflow check manually. + * + * Note that ino_t/ino64_t is unsigned... + */ + + if (OUT_OF_URANGE(realBuf.st_ino) || OUT_OF_RANGE(realBuf.st_size) + || OUT_OF_RANGE(realBuf.st_blocks)) { + errno = EOVERFLOW; + return -1; + } + +# undef OUT_OF_RANGE +# undef OUT_OF_URANGE + + /* + * Copy across all supported fields, with possible type + * coercions on those fields that change between the normal + * and lf64 versions of the stat structure (on Solaris at + * least.) This is slow when the structure sizes coincide, + * but that's what you get for mixing interfaces... + */ + + buf->st_mode = realBuf.st_mode; + buf->st_ino = (ino_t) realBuf.st_ino; + buf->st_dev = realBuf.st_dev; + buf->st_rdev = realBuf.st_rdev; + buf->st_nlink = realBuf.st_nlink; + buf->st_uid = realBuf.st_uid; + buf->st_gid = realBuf.st_gid; + buf->st_size = (off_t) realBuf.st_size; + buf->st_atime = realBuf.st_atime; + buf->st_mtime = realBuf.st_mtime; + buf->st_ctime = realBuf.st_ctime; + buf->st_blksize = realBuf.st_blksize; + buf->st_blocks = (blkcnt_t) realBuf.st_blocks; + } + return ret; +#endif /* TCL_WIDE_INT_IS_LONG */ } /* Be careful in the compares in these tests, since the Macintosh puts a @@ -4867,7 +5002,7 @@ TestChannelCmd(clientData, interp, argc, argv) TclFormatInt(buf, IOQueued); Tcl_AppendElement(interp, buf); - TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr)); + TclFormatInt(buf, (int)Tcl_Tell((Tcl_Channel) chanPtr)); Tcl_AppendElement(interp, buf); TclFormatInt(buf, statePtr->refCount); @@ -5576,7 +5711,7 @@ TestReport(cmd, path, arg2) static int TestReportStat(path, buf) Tcl_Obj *path; /* Path of file to stat (in current CP). */ - struct stat *buf; /* Filled with results of stat call. */ + Tcl_StatBuf *buf; /* Filled with results of stat call. */ { TestReport("stat",path, NULL); return Tcl_FSStat(TestReportGetNativePath(path),buf); @@ -5584,7 +5719,7 @@ TestReportStat(path, buf) static int TestReportLstat(path, buf) Tcl_Obj *path; /* Path of file to stat (in current CP). */ - struct stat *buf; /* Filled with results of stat call. */ + Tcl_StatBuf *buf; /* Filled with results of stat call. */ { TestReport("lstat",path, NULL); return Tcl_FSLstat(TestReportGetNativePath(path),buf); diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index ca9b088..5d36cc0 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTestObj.c,v 1.9 2002/01/17 04:37:33 dgp Exp $ + * RCS: @(#) $Id: tclTestObj.c,v 1.10 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -406,6 +406,15 @@ TestindexobjCmd(clientData, interp, objc, objv) int allowAbbrev, index, index2, setError, i, result; CONST char **argv; static CONST char *tablePtr[] = {"a", "b", "check", (char *) NULL}; + /* + * Keep this structure declaration in sync with tclIndexObj.c + */ + struct IndexRep { + VOID *tablePtr; /* Pointer to the table of strings */ + int offset; /* Offset between table entries */ + int index; /* Selected index into table. */ + }; + struct IndexRep *indexRep; if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "check") == 0)) { @@ -415,13 +424,14 @@ TestindexobjCmd(clientData, interp, objc, objv) * returned on subsequent lookups. */ - Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr, - "token", 0, &index); if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) { return TCL_ERROR; } - objv[1]->internalRep.twoPtrValue.ptr2 = - (VOID *) (index2 * sizeof(char *)); + + Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr, + "token", 0, &index); + indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr; + indexRep->index = index2; result = Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr, "token", 0, &index); if (result == TCL_OK) { @@ -455,9 +465,12 @@ TestindexobjCmd(clientData, interp, objc, objv) * the index object, clear out the object's cached state. */ - if ((objv[3]->typePtr == Tcl_GetObjType("index")) - && (objv[3]->internalRep.twoPtrValue.ptr1 == (VOID *) argv)) { - objv[3]->typePtr = NULL; + if (objv[3]->typePtr == &tclIndexType) { + indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr; + if (indexRep->tablePtr == (VOID *) argv) { + objv[3]->typePtr->freeIntRepProc(objv[3]); + objv[3]->typePtr = NULL; + } } result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3], diff --git a/generic/tclVar.c b/generic/tclVar.c index a827dea..b850878 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.47 2002/01/25 21:36:09 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.48 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -2025,12 +2025,10 @@ TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */ { register Tcl_Obj *varValuePtr; - Tcl_Obj *resultPtr; int createdNewObj; /* Set 1 if var's value object is shared * so we must increment a copy (i.e. copy * on write). */ long i; - int result; varValuePtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags); if (varValuePtr == NULL) { @@ -2051,24 +2049,46 @@ TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) varValuePtr = Tcl_DuplicateObj(varValuePtr); createdNewObj = 1; } - result = Tcl_GetLongFromObj(interp, varValuePtr, &i); - if (result != TCL_OK) { +#ifdef TCL_WIDE_INT_IS_LONG + if (Tcl_GetLongFromObj(interp, varValuePtr, &i) != TCL_OK) { if (createdNewObj) { Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */ } return NULL; } Tcl_SetLongObj(varValuePtr, (i + incrAmount)); +#else + if (varValuePtr->typePtr == &tclWideIntType) { + Tcl_WideInt wide = varValuePtr->internalRep.wideValue; + Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); + } else if (varValuePtr->typePtr == &tclIntType) { + i = varValuePtr->internalRep.longValue; + Tcl_SetIntObj(varValuePtr, i + incrAmount); + } else { + /* + * Not an integer or wide internal-rep... + */ + Tcl_WideInt wide; + if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) { + if (createdNewObj) { + Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */ + } + return NULL; + } + if (wide <= Tcl_LongAsWide(LONG_MAX) + && wide >= Tcl_LongAsWide(LONG_MIN)) { + Tcl_SetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount); + } else { + Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); + } + } +#endif /* * Store the variable's new value and run any write traces. */ - resultPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, varValuePtr, flags); - if (resultPtr == NULL) { - return NULL; - } - return resultPtr; + return Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, varValuePtr, flags); } /* @@ -2105,12 +2125,10 @@ TclIncrIndexedScalar(interp, localIndex, incrAmount) long incrAmount; /* Amount to be added to variable. */ { register Tcl_Obj *varValuePtr; - Tcl_Obj *resultPtr; int createdNewObj; /* Set 1 if var's value object is shared * so we must increment a copy (i.e. copy * on write). */ long i; - int result; varValuePtr = TclGetIndexedScalar(interp, localIndex, TCL_LEAVE_ERR_MSG); if (varValuePtr == NULL) { @@ -2132,25 +2150,47 @@ TclIncrIndexedScalar(interp, localIndex, incrAmount) createdNewObj = 1; varValuePtr = Tcl_DuplicateObj(varValuePtr); } - result = Tcl_GetLongFromObj(interp, varValuePtr, &i); - if (result != TCL_OK) { +#ifdef TCL_WIDE_INT_IS_LONG + if (Tcl_GetLongFromObj(interp, varValuePtr, &i) != TCL_OK) { if (createdNewObj) { Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */ } return NULL; } Tcl_SetLongObj(varValuePtr, (i + incrAmount)); +#else + if (varValuePtr->typePtr == &tclWideIntType) { + Tcl_WideInt wide = varValuePtr->internalRep.wideValue; + Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); + } else if (varValuePtr->typePtr == &tclIntType) { + i = varValuePtr->internalRep.longValue; + Tcl_SetIntObj(varValuePtr, i + incrAmount); + } else { + /* + * Not an integer or wide internal-rep... + */ + Tcl_WideInt wide; + if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) { + if (createdNewObj) { + Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */ + } + return NULL; + } + if (wide <= Tcl_LongAsWide(LONG_MAX) + && wide >= Tcl_LongAsWide(LONG_MIN)) { + Tcl_SetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount); + } else { + Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); + } + } +#endif /* * Store the variable's new value and run any write traces. */ - resultPtr = TclSetIndexedScalar(interp, localIndex, varValuePtr, + return TclSetIndexedScalar(interp, localIndex, varValuePtr, TCL_LEAVE_ERR_MSG); - if (resultPtr == NULL) { - return NULL; - } - return resultPtr; } /* @@ -2191,12 +2231,10 @@ TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount) long incrAmount; /* Amount to be added to variable. */ { register Tcl_Obj *varValuePtr; - Tcl_Obj *resultPtr; int createdNewObj; /* Set 1 if var's value object is shared * so we must increment a copy (i.e. copy * on write). */ long i; - int result; varValuePtr = TclGetElementOfIndexedArray(interp, localIndex, elemPtr, TCL_LEAVE_ERR_MSG); @@ -2219,25 +2257,47 @@ TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount) createdNewObj = 1; varValuePtr = Tcl_DuplicateObj(varValuePtr); } - result = Tcl_GetLongFromObj(interp, varValuePtr, &i); - if (result != TCL_OK) { +#ifdef TCL_WIDE_INT_IS_LONG + if (Tcl_GetLongFromObj(interp, varValuePtr, &i) != TCL_OK) { if (createdNewObj) { Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */ } return NULL; } Tcl_SetLongObj(varValuePtr, (i + incrAmount)); - +#else + if (varValuePtr->typePtr == &tclWideIntType) { + Tcl_WideInt wide = varValuePtr->internalRep.wideValue; + Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); + } else if (varValuePtr->typePtr == &tclIntType) { + i = varValuePtr->internalRep.longValue; + Tcl_SetIntObj(varValuePtr, i + incrAmount); + } else { + /* + * Not an integer or wide internal-rep... + */ + Tcl_WideInt wide; + if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) { + if (createdNewObj) { + Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */ + } + return NULL; + } + if (wide <= Tcl_LongAsWide(LONG_MAX) + && wide >= Tcl_LongAsWide(LONG_MIN)) { + Tcl_SetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount); + } else { + Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); + } + } +#endif + /* * Store the variable's new value and run any write traces. */ - resultPtr = TclSetElementOfIndexedArray(interp, localIndex, elemPtr, + return TclSetElementOfIndexedArray(interp, localIndex, elemPtr, varValuePtr, TCL_LEAVE_ERR_MSG); - if (resultPtr == NULL) { - return NULL; - } - return resultPtr; } /* diff --git a/mac/tclMacChan.c b/mac/tclMacChan.c index 90be8a4..6b83e2f 100644 --- a/mac/tclMacChan.c +++ b/mac/tclMacChan.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacChan.c,v 1.12 2002/01/27 11:09:38 das Exp $ + * RCS: @(#) $Id: tclMacChan.c,v 1.13 2002/02/15 14:28:49 dkf Exp $ */ #include "tclInt.h" @@ -109,8 +109,8 @@ static int FileInput _ANSI_ARGS_((ClientData instanceData, char *buf, int toRead, int *errorCode)); static int FileOutput _ANSI_ARGS_((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)); -static int FileSeek _ANSI_ARGS_((ClientData instanceData, - long offset, int mode, int *errorCode)); +static Tcl_WideInt FileSeek _ANSI_ARGS_((ClientData instanceData, + Tcl_WideInt offset, int mode, int *errorCode)); static void FileSetupProc _ANSI_ARGS_((ClientData clientData, int flags)); static int GetOpenMode _ANSI_ARGS_((Tcl_Interp *interp, @@ -125,8 +125,8 @@ static int StdIOInput _ANSI_ARGS_((ClientData instanceData, char *buf, int toRead, int *errorCode)); static int StdIOOutput _ANSI_ARGS_((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)); -static int StdIOSeek _ANSI_ARGS_((ClientData instanceData, - long offset, int mode, int *errorCode)); +static Tcl_WideInt StdIOSeek _ANSI_ARGS_((ClientData instanceData, + Tcl_WideInt offset, int mode, int *errorCode)); static int StdReady _ANSI_ARGS_((ClientData instanceData, int mask)); @@ -584,13 +584,12 @@ StdIOOutput( *---------------------------------------------------------------------- */ -static int +static Tcl_WideInt StdIOSeek( - ClientData instanceData, /* Unused. */ - long offset, /* Offset to seek to. */ - int mode, /* Relative to where - * should we seek? */ - int *errorCodePtr) /* To store error code. */ + ClientData instanceData, /* Unused. */ + Tcl_WideInt offset, /* Offset to seek to. */ + int mode, /* Relative to where should we seek? */ + int *errorCodePtr) /* To store error code. */ { int newLoc; int fd; @@ -1126,13 +1125,12 @@ FileOutput( *---------------------------------------------------------------------- */ -static int +static Tcl_WideInt FileSeek( ClientData instanceData, /* Unused. */ - long offset, /* Offset to seek to. */ - int mode, /* Relative to where - * should we seek? */ - int *errorCodePtr) /* To store error code. */ + Tcl_WideInt offset, /* Offset to seek to. */ + int mode, /* Relative to where should we seek? */ + int *errorCodePtr) /* To store error code. */ { FileState *fileState = (FileState *) instanceData; IOParam pb; diff --git a/mac/tclMacFile.c b/mac/tclMacFile.c index 522372a..fe26027 100644 --- a/mac/tclMacFile.c +++ b/mac/tclMacFile.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacFile.c,v 1.16 2002/01/27 11:09:49 das Exp $ + * RCS: @(#) $Id: tclMacFile.c,v 1.17 2002/02/15 14:28:49 dkf Exp $ */ /* @@ -253,7 +253,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) typeOk = 0; } } else { - struct stat buf; + Tcl_StatBuf buf; if (pb.hFileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) { /* If invisible */ @@ -723,7 +723,7 @@ TclpReadlink( int TclpObjLstat(pathPtr, buf) Tcl_Obj *pathPtr; - struct stat *buf; + Tcl_StatBuf *buf; { /* This needs to be enhanced to deal with aliases */ return TclpObjStat(pathPtr, buf); @@ -748,7 +748,7 @@ TclpObjLstat(pathPtr, buf) int TclpObjStat(pathPtr, bufPtr) Tcl_Obj *pathPtr; - struct stat *bufPtr; + Tcl_StatBuf *bufPtr; { HFileInfo fpb; HVolumeParam vpb; diff --git a/tests/binary.test b/tests/binary.test index 6e8b64a..b01ae3c 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -10,14 +10,14 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: binary.test,v 1.8 2000/05/26 08:50:34 hobbs Exp $ +# RCS: @(#) $Id: binary.test,v 1.9 2002/02/15 14:28:49 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } -test binary-2.1 {DupByteArrayInternalRep} { +test binary-0.1 {DupByteArrayInternalRep} { set hdr [binary format cc 0 0316] set buf hellomatt @@ -1460,6 +1460,32 @@ test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} { set result } {bad option "": must be format or scan} +# Wide int (guaranteed at least 64-bit) handling +test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} { + binary format w 7810179016327718216 +} HelloTcl +test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} { + binary format W 7810179016327718216 +} lcTolleH + +test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} { + binary scan HelloTcl W x + set x +} 5216694956358656876 +test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} { + binary scan lcTolleH w x + set x +} 5216694956358656876 + +test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} { + binary scan [binary format sws 16450 -1 19521] c* x + set x +} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76} +test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} { + binary scan [binary format sWs 16450 0x7fffffff 19521] c* x + set x +} {66 64 0 0 0 0 127 -1 -1 -1 65 76} + # cleanup ::tcltest::cleanupTests return diff --git a/tests/execute.test b/tests/execute.test index e82ac57..c59292a 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: execute.test,v 1.9 2001/02/23 21:41:01 msofer Exp $ +# RCS: @(#) $Id: execute.test,v 1.10 2002/02/15 14:28:50 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -33,6 +33,9 @@ set ::tcltest::testConstraints(testobj) \ && [info commands teststringobj] != {} \ && [info commands testobj] != {}}] +set ::tcltest::testConstraints(longIs32bit) \ + [expr {int(0x80000000) < 0}] + # Tests for the omnibus TclExecuteByteCode function: # INST_DONE not tested @@ -589,6 +592,127 @@ test execute-6.2 {Evaluate an expression in a variable; compile the first time, set res "[a $w]:[a $w]" } {15:15} +test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} { + set x 0x100000000 + expr {$x && 1} +} 1 +test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} { + expr {0x100000000 && 1} +} 1 +test execute-7.2 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} { + expr {1 && 0x100000000} +} 1 +test execute-7.3 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} { + expr {wide(0x100000000) && 1} +} 1 +test execute-7.4 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} { + expr {1 && wide(0x100000000)} +} 1 +test execute-7.5 {Wide int handling in INST_EQ} {longIs32bit} { + expr {4 == (wide(1)+wide(3))} +} 1 +test execute-7.6 {Wide int handling in INST_EQ and [incr]} {longIs32bit} { + set x 399999999999 + expr {400000000000 == [incr x]} +} 1 +# wide ints have more bits of precision than doubles, but we convert anyway +test execute-7.7 {Wide int handling in INST_EQ and [incr]} {longIs32bit} { + set x [expr {wide(1)<<62}] + set y [expr {$x+1}] + expr {double($x) == double($y)} +} 1 +test execute-7.8 {Wide int conversions can change sign} {longIs32bit} { + set x 0x80000000 + expr {int($x) < wide($x)} +} 1 +test execute-7.9 {Wide int handling in INST_MOD} {longIs32bit} { + expr {(wide(1)<<60) % ((wide(47)<<45)-1)} +} 316659348800185 +test execute-7.10 {Wide int handling in INST_MOD} {longIs32bit} { + expr {((wide(1)<<60)-1) % 0x400000000} +} 17179869183 +test execute-7.11 {Wide int handling in INST_LSHIFT} {longIs32bit} { + expr wide(42)<<30 +} 45097156608 +test execute-7.12 {Wide int handling in INST_LSHIFT} {longIs32bit} { + expr 12345678901<<3 +} 98765431208 +test execute-7.13 {Wide int handling in INST_RSHIFT} {longIs32bit} { + expr 0x543210febcda9876>>7 +} 47397893236700464 +test execute-7.14 {Wide int handling in INST_RSHIFT} {longIs32bit} { + expr 0x9876543210febcda>>7 +} -58286587177206407 +test execute-7.15 {Wide int handling in INST_BITOR} {longIs32bit} { + expr 0x9876543210febcda | 0x543210febcda9876 +} -2560765885044310786 +test execute-7.16 {Wide int handling in INST_BITXOR} {longIs32bit} { + expr 0x9876543210febcda ^ 0x543210febcda9876 +} -3727778945703861076 +test execute-7.17 {Wide int handling in INST_BITAND} {longIs32bit} { + expr 0x9876543210febcda & 0x543210febcda9876 +} 1167013060659550290 +test execute-7.18 {Wide int handling in INST_ADD} {longIs32bit} { + expr wide(0x7fffffff)+wide(0x7fffffff) +} 4294967294 +test execute-7.19 {Wide int handling in INST_ADD} {longIs32bit} { + expr 0x7fffffff+wide(0x7fffffff) +} 4294967294 +test execute-7.20 {Wide int handling in INST_ADD} {longIs32bit} { + expr wide(0x7fffffff)+0x7fffffff +} 4294967294 +test execute-7.21 {Wide int handling in INST_ADD} {longIs32bit} { + expr double(0x7fffffff)+wide(0x7fffffff) +} 4294967294.0 +test execute-7.22 {Wide int handling in INST_ADD} {longIs32bit} { + expr wide(0x7fffffff)+double(0x7fffffff) +} 4294967294.0 +test execute-7.23 {Wide int handling in INST_SUB} {longIs32bit} { + expr 0x123456789a-0x20406080a +} 69530054800 +test execute-7.24 {Wide int handling in INST_MULT} {longIs32bit} { + expr 0x123456789a*193 +} 15090186251290 +test execute-7.25 {Wide int handling in INST_DIV} {longIs32bit} { + expr 0x123456789a/193 +} 405116546 +test execute-7.26 {Wide int handling in INST_UPLUS} {longIs32bit} { + set x 0x123456871234568 + expr {+ $x} +} 81985533099853160 +test execute-7.27 {Wide int handling in INST_UMINUS} {longIs32bit} { + set x 0x123456871234568 + expr {- $x} +} -81985533099853160 +test execute-7.28 {Wide int handling in INST_LNOT} {longIs32bit} { + set x 0x123456871234568 + expr {! $x} +} 0 +test execute-7.29 {Wide int handling in INST_BITNOT} {longIs32bit} { + set x 0x123456871234568 + expr {~ $x} +} -81985533099853161 +test execute-7.30 {Wide int handling in function call} {longIs32bit} { + set x 0x12345687123456 + incr x + expr {sin($x) == sin(double($x))} +} 1 +test execute-7.31 {Wide int handling in abs()} {longIs32bit} { + set x 0xa23456871234568 + incr x + set y 0x123456871234568 + concat [expr {abs($x)}] [expr {abs($y)}] +} {730503879441204585 81985533099853160} +test execute-7.32 {Wide int handling} {longIs32bit} { + expr {1024 * 1024 * 1024 * 1024} +} 0 +test execute-7.33 {Wide int handling} {longIs32bit} { + expr {0x1 * 1024 * 1024 * 1024 * 1024} +} 0 +test execute-7.34 {Wide int handling} {longIs32bit} { + expr {wide(0x1) * 1024 * 1024 * 1024 * 1024} +} 1099511627776 + # cleanup catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename foo ""} @@ -600,22 +724,3 @@ catch {unset y} catch {unset msg} ::tcltest::cleanupTests return - - - - - - - - - - - - - - - - - - - diff --git a/tests/format.test b/tests/format.test index 67a4086..b7990b3 100644 --- a/tests/format.test +++ b/tests/format.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: format.test,v 1.9 2001/08/23 13:57:08 dkf Exp $ +# RCS: @(#) $Id: format.test,v 1.10 2002/02/15 14:28:50 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -481,12 +481,27 @@ for {set i 0} {$i < 290} {incr i} { append b $a } for {set i 290} {$i < 400} {incr i} { - test format-15.[expr $i -290] {testing MAX_FLOAT_SIZE} { + test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} { format {%s} $b } $b append b "x" } +set ::tcltest::testConstraints(64bitInts) \ + [expr {0x80000000 > 0}] +set ::tcltest::testConstraints(wideIntExpressions) \ + [expr {wide(0x80000000) != int(0x80000000)}] + +test format-17.1 {testing %d with wide} {64bitInts wideIntExpressions} { + list [catch {format %d 7810179016327718216} msg] $msg +} {1 {integer value too large to represent}} +test format-17.2 {testing %ld with wide} {64bitInts} { + format %ld 7810179016327718216 +} 7810179016327718216 +test format-17.3 {testing %ld with non-wide} {64bitInts} { + format %ld 42 +} 42 + # cleanup catch {unset a} catch {unset b} diff --git a/tests/get.test b/tests/get.test index 946e4c6..a2efcea 100644 --- a/tests/get.test +++ b/tests/get.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: get.test,v 1.5 2000/04/10 17:18:59 ericm Exp $ +# RCS: @(#) $Id: get.test,v 1.6 2002/02/15 14:28:50 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -45,7 +45,7 @@ test get-1.6 {Tcl_GetInt procedure} { # The following tests are non-portable because they depend on # word size. -if {0x80000000 > 0} { +if {wide(0x80000000) > wide(0)} { test get-1.7 {Tcl_GetInt procedure} { set x 44 list [catch {incr x 18446744073709551616} msg] $msg $errorCode @@ -63,19 +63,19 @@ if {0x80000000 > 0} { list [catch {incr x -18446744073709551614} msg] $msg } {0 2} } else { - test get-1.7 {Tcl_GetInt procedure} { + test get-1.11 {Tcl_GetInt procedure} { set x 44 list [catch {incr x 4294967296} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} - test get-1.8 {Tcl_GetInt procedure} { + test get-1.12 {Tcl_GetInt procedure} { set x 0 list [catch {incr x 4294967294} msg] $msg } {0 -2} - test get-1.9 {Tcl_GetInt procedure} { + test get-1.13 {Tcl_GetInt procedure} { set x 0 list [catch {incr x +4294967294} msg] $msg } {0 -2} - test get-1.10 {Tcl_GetInt procedure} { + test get-1.14 {Tcl_GetInt procedure} { set x 0 list [catch {incr x -4294967294} msg] $msg } {0 2} diff --git a/tests/info.test b/tests/info.test index b82f7e6..9ed73b2 100644 --- a/tests/info.test +++ b/tests/info.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: info.test,v 1.17 2001/05/30 08:57:06 dkf Exp $ +# RCS: @(#) $Id: info.test,v 1.18 2002/02/15 14:28:50 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -593,9 +593,9 @@ test info-19.5 {info vars with temporary variables} { # Check whether the extra testing functions are defined... if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} { - set functions {abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh} + set functions {abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide} } else { - set functions {T1 T2 T3 abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh} + set functions {T1 T2 T3 abs acos asin atan atan2 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide} } test info-20.1 {info functions option} {info functions sin} sin test info-20.2 {info functions option} {lsort [info functions]} $functions diff --git a/tests/io.test b/tests/io.test index 5cb1ccf..6c8cf79 100644 --- a/tests/io.test +++ b/tests/io.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.25 2002/02/01 21:19:03 andreas_kupries Exp $ +# RCS: @(#) $Id: io.test,v 1.26 2002/02/15 14:28:50 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -21,6 +21,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { tcltest::testConstraint testchannel [string equal testchannel [info commands testchannel]] +# You need a *very* special environment to do some tests. In +# particular, many file systems do not support large-files... +tcltest::testConstraint largefileSupport 0 + ::tcltest::saveState removeFile test1 @@ -3811,12 +3815,12 @@ test io-32.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} { set z [read $f1 1000000] close $f1 set x ok - set l [string length $z]] - set z [file size longfile]] + set l [string length $z] + set z [file size longfile] if {$z != $l} { set x broken } - set x + set x } ok test io-32.9 {Tcl_Read, read to end of file} { set f1 [open longfile r] @@ -4317,6 +4321,28 @@ test io-34.20 {Tcl_Tell combined with writing} { close $f set l } {29 39 40 447} +test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} { + removeFile test3 + set f [open test3 w] + fconfigure $f -encoding binary + set l "" + lappend l [tell $f] + puts -nonewline $f abcdef + lappend l [tell $f] + flush $f + lappend l [tell $f] + # 4GB offset! + seek $f 0x100000000 + lappend l [tell $f] + puts -nonewline $f abcdef + lappend l [tell $f] + close $f + lappend l [file size $f] + # truncate... + close [open test3 w] + lappend l [file size $f] + set l +} {0 6 6 4294967296 4294967302 4294967302 0} # Test Tcl_Eof diff --git a/tests/link.test b/tests/link.test index f64711a..ae06584 100644 --- a/tests/link.test +++ b/tests/link.test @@ -11,246 +11,252 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: link.test,v 1.5 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: link.test,v 1.6 2002/02/15 14:28:50 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } -if {[info commands testlink] == {}} { - puts "This application hasn't been compiled with the \"testlink\"" - puts "command, so I can't test Tcl_LinkVar et al." - ::tcltest::cleanupTests - return -} +set ::tcltest::testConstraints(testlink) \ + [expr {[info commands testlink] != {}}] foreach i {int real bool string} { catch {unset $i} } -test link-1.1 {reading C variables from Tcl} { +test link-1.1 {reading C variables from Tcl} {testlink} { testlink delete - testlink set 43 1.23 4 - - testlink create 1 1 1 1 - list $int $real $bool $string -} {43 1.23 1 NULL} -test link-1.2 {reading C variables from Tcl} { + testlink set 43 1.23 4 - 12341234 + testlink create 1 1 1 1 1 + list $int $real $bool $string $wide +} {43 1.23 1 NULL 12341234} +test link-1.2 {reading C variables from Tcl} {testlink} { testlink delete - testlink create 1 1 1 1 - testlink set -3 2 0 "A long string with spaces" - list $int $real $bool $string $int $real $bool $string -} {-3 2.0 0 {A long string with spaces} -3 2.0 0 {A long string with spaces}} + testlink create 1 1 1 1 1 + testlink set -3 2 0 "A long string with spaces" 43214321 + list $int $real $bool $string $wide $int $real $bool $string $wide +} {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321} -test link-2.1 {writing C variables from Tcl} { +test link-2.1 {writing C variables from Tcl} {testlink} { testlink delete - testlink set 43 1.21 4 - - testlink create 1 1 1 1 + testlink set 43 1.21 4 - 56785678 + testlink create 1 1 1 1 1 set int "00721" set real -10.5 set bool true set string abcdef - concat [testlink get] $int $real $bool $string -} {465 -10.5 1 abcdef 00721 -10.5 true abcdef} -test link-2.2 {writing bad values into variables} { + set wide 135135 + concat [testlink get] $int $real $bool $string $wide +} {465 -10.5 1 abcdef 135135 00721 -10.5 true abcdef 135135} +test link-2.2 {writing bad values into variables} {testlink} { testlink delete - testlink set 43 1.23 4 - - testlink create 1 1 1 1 + testlink set 43 1.23 4 - 56785678 + testlink create 1 1 1 1 1 list [catch {set int 09a} msg] $msg $int } {1 {can't set "int": variable must have integer value} 43} -test link-2.3 {writing bad values into variables} { +test link-2.3 {writing bad values into variables} {testlink} { testlink delete - testlink set 43 1.23 4 - - testlink create 1 1 1 1 + testlink set 43 1.23 4 - 56785678 + testlink create 1 1 1 1 1 list [catch {set real 1.x3} msg] $msg $real } {1 {can't set "real": variable must have real value} 1.23} -test link-2.4 {writing bad values into variables} { +test link-2.4 {writing bad values into variables} {testlink} { testlink delete - testlink set 43 1.23 4 - - testlink create 1 1 1 1 + testlink set 43 1.23 4 - 56785678 + testlink create 1 1 1 1 1 list [catch {set bool gorp} msg] $msg $bool } {1 {can't set "bool": variable must have boolean value} 1} +test link-2.5 {writing bad values into variables} {testlink} { + testlink delete + testlink set 43 1.23 4 - 56785678 + testlink create 1 1 1 1 1 + list [catch {set wide gorp} msg] $msg $bool +} {1 {can't set "wide": variable must have integer value} 1} -test link-3.1 {read-only variables} { +test link-3.1 {read-only variables} {testlink} { testlink delete - testlink set 43 1.23 4 - - testlink create 0 1 1 0 + testlink set 43 1.23 4 - 56785678 + testlink create 0 1 1 0 0 list [catch {set int 4} msg] $msg $int \ [catch {set real 10.6} msg] $msg $real \ [catch {set bool no} msg] $msg $bool \ - [catch {set string "new value"} msg] $msg $string -} {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL} -test link-3.2 {read-only variables} { + [catch {set string "new value"} msg] $msg $string \ + [catch {set wide 12341234} msg] $msg $wide +} {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678} +test link-3.2 {read-only variables} {testlink} { testlink delete - testlink set 43 1.23 4 - - testlink create 1 0 0 1 + testlink set 43 1.23 4 - 56785678 + testlink create 1 0 0 1 1 list [catch {set int 4} msg] $msg $int \ [catch {set real 10.6} msg] $msg $real \ [catch {set bool no} msg] $msg $bool \ - [catch {set string "new value"} msg] $msg $string -} {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value}} + [catch {set string "new value"} msg] $msg $string\ + [catch {set wide 12341234} msg] $msg $wide +} {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234} -test link-4.1 {unsetting linked variables} { +test link-4.1 {unsetting linked variables} {testlink} { testlink delete - testlink set -6 -2.5 0 stringValue - testlink create 1 1 1 1 - unset int real bool string + testlink set -6 -2.5 0 stringValue 13579 + testlink create 1 1 1 1 1 + unset int real bool string wide list [catch {set int} msg] $msg [catch {set real} msg] $msg \ - [catch {set bool} msg] $msg [catch {set string} msg] $msg -} {0 -6 0 -2.5 0 0 0 stringValue} -test link-4.2 {unsetting linked variables} { + [catch {set bool} msg] $msg [catch {set string} msg] $msg \ + [catch {set wide} msg] $msg +} {0 -6 0 -2.5 0 0 0 stringValue 0 13579} +test link-4.2 {unsetting linked variables} {testlink} { testlink delete - testlink set -6 -2.1 0 stringValue - testlink create 1 1 1 1 - unset int real bool string + testlink set -6 -2.1 0 stringValue 97531 + testlink create 1 1 1 1 1 + unset int real bool string wide set int 102 set real 16 set bool true set string newValue + set wide 333555 testlink get -} {102 16.0 1 newValue} +} {102 16.0 1 newValue 333555} -test link-5.1 {unlinking variables} { +test link-5.1 {unlinking variables} {testlink} { testlink delete - testlink set -6 -2.25 0 stringValue + testlink set -6 -2.25 0 stringValue 13579 testlink delete set int xx1 set real qrst set bool bogus set string 12345 + set wide 875421 testlink get -} {-6 -2.25 0 stringValue} -test link-5.2 {unlinking variables} { +} {-6 -2.25 0 stringValue 13579} +test link-5.2 {unlinking variables} {testlink} { testlink delete - testlink set -6 -2.25 0 stringValue - testlink create 1 1 1 1 + testlink set -6 -2.25 0 stringValue 97531 + testlink create 1 1 1 1 1 testlink delete - testlink set 25 14.7 7 - - list $int $real $bool $string -} {-6 -2.25 0 stringValue} + testlink set 25 14.7 7 - 999999 + list $int $real $bool $string $wide +} {-6 -2.25 0 stringValue 97531} -test link-6.1 {errors in setting up link} { +test link-6.1 {errors in setting up link} {testlink} { testlink delete catch {unset int} set int(44) 1 - list [catch {testlink create 1 1 1 1} msg] $msg + list [catch {testlink create 1 1 1 1 1} msg] $msg } {1 {can't set "int": variable is array}} catch {unset int} -test link-7.1 {access to linked variables via upvar} { +test link-7.1 {access to linked variables via upvar} {testlink} { proc x {} { upvar int y unset y } testlink delete - testlink create 1 0 0 0 - testlink set 14 {} {} {} + testlink create 1 0 0 0 0 + testlink set 14 {} {} {} {} x list [catch {set int} msg] $msg } {0 14} -test link-7.2 {access to linked variables via upvar} { +test link-7.2 {access to linked variables via upvar} {testlink} { proc x {} { upvar int y return [set y] } testlink delete - testlink create 1 0 0 0 - testlink set 0 {} {} {} + testlink create 1 0 0 0 0 + testlink set 0 {} {} {} {} set int - testlink set 23 {} {} {} + testlink set 23 {} {} {} {} x list [x] $int } {23 23} -test link-7.3 {access to linked variables via upvar} { +test link-7.3 {access to linked variables via upvar} {testlink} { proc x {} { upvar int y set y 44 } testlink delete - testlink create 0 0 0 0 - testlink set 11 {} {} {} + testlink create 0 0 0 0 0 + testlink set 11 {} {} {} {} list [catch x msg] $msg $int } {1 {can't set "y": linked variable is read-only} 11} -test link-7.4 {access to linked variables via upvar} { +test link-7.4 {access to linked variables via upvar} {testlink} { proc x {} { upvar int y set y abc } testlink delete - testlink create 1 1 1 1 - testlink set -4 {} {} {} + testlink create 1 1 1 1 1 + testlink set -4 {} {} {} {} list [catch x msg] $msg $int } {1 {can't set "y": variable must have integer value} -4} -test link-7.5 {access to linked variables via upvar} { +test link-7.5 {access to linked variables via upvar} {testlink} { proc x {} { upvar real y set y abc } testlink delete - testlink create 1 1 1 1 - testlink set -4 16.75 {} {} + testlink create 1 1 1 1 1 + testlink set -4 16.75 {} {} {} list [catch x msg] $msg $real } {1 {can't set "y": variable must have real value} 16.75} -test link-7.6 {access to linked variables via upvar} { +test link-7.6 {access to linked variables via upvar} {testlink} { proc x {} { upvar bool y set y abc } testlink delete - testlink create 1 1 1 1 - testlink set -4 16.3 1 {} + testlink create 1 1 1 1 1 + testlink set -4 16.3 1 {} {} list [catch x msg] $msg $bool } {1 {can't set "y": variable must have boolean value} 1} +test link-7.7 {access to linked variables via upvar} {testlink} { + proc x {} { + upvar wide y + set y abc + } + testlink delete + testlink create 1 1 1 1 1 + testlink set -4 16.3 1 {} 778899 + list [catch x msg] $msg $wide +} {1 {can't set "y": variable must have integer value} 778899} -test link-8.1 {Tcl_UpdateLinkedVar procedure} { +test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} { proc x args { - global x int real bool string - lappend x $args $int $real $bool $string + global x int real bool string wide + lappend x $args $int $real $bool $string $wide } set x {} - testlink create 1 1 1 1 - testlink set 14 -2.0 0 xyzzy + testlink create 1 1 1 1 1 + testlink set 14 -2.0 0 xyzzy 995511 trace var int w x - testlink update 32 4.0 3 abcd + testlink update 32 4.0 3 abcd 113355 trace vdelete int w x set x -} {{int {} w} 32 -2.0 0 xyzzy} -test link-8.2 {Tcl_UpdateLinkedVar procedure} { +} {{int {} w} 32 -2.0 0 xyzzy 995511} +test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} { proc x args { - global x int real bool string - lappend x $args $int $real $bool $string + global x int real bool string wide + lappend x $args $int $real $bool $string $wide } set x {} - testlink create 1 1 1 1 - testlink set 14 -2.0 0 xyzzy + testlink create 1 1 1 1 1 + testlink set 14 -2.0 0 xyzzy 995511 testlink delete trace var int w x - testlink update 32 4.0 6 abcd + testlink update 32 4.0 6 abcd 113355 trace vdelete int w x set x } {} -test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} { - testlink create 0 0 0 0 - list [catch {testlink update 47 {} {} {}} msg] $msg $int +test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} { + testlink create 0 0 0 0 0 + list [catch {testlink update 47 {} {} {} {}} msg] $msg $int } {0 {} 47} -testlink set 0 0 0 - -testlink delete -foreach i {int real bool string} { +catch {testlink set 0 0 0 - 0} +catch {testlink delete} +foreach i {int real bool string wide} { catch {unset $i} } # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - diff --git a/tests/platform.test b/tests/platform.test index 9c7dec5..19001ee 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -23,19 +23,19 @@ test platform-1.1 {TclpSetVariables: tcl_platform} { set result [i eval {lsort [array names tcl_platform]}] interp delete i set result -} {byteOrder machine os osVersion platform user} +} {byteOrder machine os osVersion platform user wordSize} + +# Test assumes twos-complement arithmetic, which is true of virtually +# everything these days. Note that this does *not* use wide(), and +# this is intentional since that could make Tcl's numbers wider than +# the machine-integer on some platforms... +test platform-2.1 {tcl_platform(wordSize) indicates size of native word} { + set result [expr {1 << (8 * $tcl_platform(wordSize) - 1)}] + # Result must be the largest bit in a machine word, which this checks + # without assuming how wide the word really is + list [expr {$result < 0}] [expr {$result ^ ($result - 1)}] +} {1 -1} # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - diff --git a/tests/safe.test b/tests/safe.test index 2eb6788..1642d8e 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: safe.test,v 1.10 2000/11/17 11:06:54 dkf Exp $ +# RCS: @(#) $Id: safe.test,v 1.11 2002/02/15 14:28:50 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -185,7 +185,7 @@ test safe-6.3 {test safe interpreters knowledge of the world} { set r [lreplace $r $threaded $threaded] } set r -} {byteOrder platform} +} {byteOrder platform wordSize} # more test should be added to check that hostname, nameofexecutable, # aren't leaking infos, but they still do... @@ -518,15 +518,3 @@ test safe-11.8 {testing safe encoding} { # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - diff --git a/tests/scan.test b/tests/scan.test index d3d8c96..2bfa49a 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -11,13 +11,16 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: scan.test,v 1.12 2002/02/07 01:50:46 hobbs Exp $ +# RCS: @(#) $Id: scan.test,v 1.13 2002/02/15 14:28:50 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } +set ::tcltest::testConstraints(64bitInts) \ + [expr {0x80000000 > 0}] + test scan-1.1 {BuildCharSet, CharInSet} { list [scan foo {%[^o]} x] $x } {1 f} @@ -416,6 +419,12 @@ test scan-5.11 {integer scanning} {nonPortable} { [expr {$b == -16 || $b == 0x7fffffff}] } {2 4294967280 1} +test scan-5.12 {integer scanning} {64bitInts} { + set a {}; set b {}; set c {} + list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \ + %ld,%lx,%lo a b c] $a $b $c +} {3 7810179016327718216 7810179016327718216 7810179016327718216} + test scan-6.1 {floating-point scanning} { set a {}; set b {}; set c {}; set d {} list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d diff --git a/tests/string.test b/tests/string.test index c66390f..8cc5e00 100644 --- a/tests/string.test +++ b/tests/string.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: string.test,v 1.32 2002/02/07 00:51:55 hobbs Exp $ +# RCS: @(#) $Id: string.test,v 1.33 2002/02/15 14:28:50 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -274,7 +274,7 @@ proc largest_int {} { # so we can test for overflow properly below on >32 bit systems set int 1 set exp 7; # assume we get at least 8 bits - while {$int > 0} { set int [expr {1 << [incr exp]}] } + while {$int > 0} { set int [expr {wide(1) << [incr exp]}] } return [expr {$int-1}] } diff --git a/unix/Makefile.in b/unix/Makefile.in index a18b24b..a80d27f 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.93 2002/01/11 19:17:49 mdejong Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.94 2002/02/15 14:28:50 dkf Exp $ VERSION = @TCL_VERSION@ @@ -1047,9 +1047,15 @@ strtod.o: $(COMPAT_DIR)/strtod.c strtol.o: $(COMPAT_DIR)/strtol.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c +strtoll.o: $(COMPAT_DIR)/strtoll.c + $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoll.c + strtoul.o: $(COMPAT_DIR)/strtoul.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoul.c +strtoull.o: $(COMPAT_DIR)/strtoull.c + $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoull.c + tmpnam.o: $(COMPAT_DIR)/tmpnam.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/tmpnam.c diff --git a/unix/configure b/unix/configure index d2c6490..1c852f1 100755 --- a/unix/configure +++ b/unix/configure @@ -1303,6 +1303,281 @@ fi fi #-------------------------------------------------------------------- +# Detect what compiler flags to set for 64-bit support. +#-------------------------------------------------------------------- + + + echo $ac_n "checking for required early compiler flags""... $ac_c" 1>&6 +echo "configure:1312: checking for required early compiler flags" >&5 + tcl_flags="" + + if eval "test \"`echo '$''{'tcl_cv_flag__isoc99_source'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 1319 "configure" +#include "confdefs.h" +#include <stdlib.h> +int main() { +char *p = (char *)strtoll; char *q = (char *)strtoull; +; return 0; } +EOF +if { (eval echo configure:1326: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + tcl_cv_flag__isoc99_source=no +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + cat > conftest.$ac_ext <<EOF +#line 1334 "configure" +#include "confdefs.h" +#define _ISOC99_SOURCE 1 +#include <stdlib.h> +int main() { +char *p = (char *)strtoll; char *q = (char *)strtoull; +; return 0; } +EOF +if { (eval echo configure:1342: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + tcl_cv_flag__isoc99_source=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + tcl_cv_flag__isoc99_source=no +fi +rm -f conftest* +fi +rm -f conftest* +fi + + if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then + cat >> confdefs.h <<\EOF +#define _ISOC99_SOURCE 1 +EOF + + tcl_flags="$tcl_flags _ISOC99_SOURCE" + fi + + if eval "test \"`echo '$''{'tcl_cv_flag__largefile64_source'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 1368 "configure" +#include "confdefs.h" +#include <sys/stat.h> +int main() { +struct stat64 buf; int i = stat64("/", &buf); +; return 0; } +EOF +if { (eval echo configure:1375: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + tcl_cv_flag__largefile64_source=no +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + cat > conftest.$ac_ext <<EOF +#line 1383 "configure" +#include "confdefs.h" +#define _LARGEFILE64_SOURCE 1 +#include <sys/stat.h> +int main() { +struct stat64 buf; int i = stat64("/", &buf); +; return 0; } +EOF +if { (eval echo configure:1391: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + tcl_cv_flag__largefile64_source=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + tcl_cv_flag__largefile64_source=no +fi +rm -f conftest* +fi +rm -f conftest* +fi + + if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then + cat >> confdefs.h <<\EOF +#define _LARGEFILE64_SOURCE 1 +EOF + + tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" + fi + if test "x${tcl_flags}" = "x" ; then + echo "$ac_t""none" 1>&6 + else + echo "$ac_t""${tcl_flags}" 1>&6 + fi + + + echo $ac_n "checking for 64-bit integer type""... $ac_c" 1>&6 +echo "configure:1420: checking for 64-bit integer type" >&5 + if eval "test \"`echo '$''{'tcl_cv_type_64bit'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + cat > conftest.$ac_ext <<EOF +#line 1426 "configure" +#include "confdefs.h" + +int main() { +__int64 value = (__int64) 0; +; return 0; } +EOF +if { (eval echo configure:1433: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + tcl_cv_type_64bit=__int64 +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + tcl_cv_type_64bit=none + if test "$cross_compiling" = yes; then + { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; } +else + cat > conftest.$ac_ext <<EOF +#line 1445 "configure" +#include "confdefs.h" +#include <unistd.h> + int main() {exit(!(sizeof(long long) > sizeof(long)));} + +EOF +if { (eval echo configure:1451: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then + tcl_cv_type_64bit="long long" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 +fi +rm -fr conftest* +fi + +fi +rm -f conftest* +fi + + if test "${tcl_cv_type_64bit}" = none ; then + echo "$ac_t""using long" 1>&6 + else + cat >> confdefs.h <<EOF +#define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit} +EOF + + echo "$ac_t""${tcl_cv_type_64bit}" 1>&6 + + # Now check for auxiliary declarations + echo $ac_n "checking for struct dirent64""... $ac_c" 1>&6 +echo "configure:1476: checking for struct dirent64" >&5 + if eval "test \"`echo '$''{'tcl_cv_struct_dirent64'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + cat > conftest.$ac_ext <<EOF +#line 1482 "configure" +#include "confdefs.h" +#include <sys/types.h> +#include <sys/dirent.h> +int main() { +struct dirent64 p; +; return 0; } +EOF +if { (eval echo configure:1490: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + tcl_cv_struct_dirent64=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + tcl_cv_struct_dirent64=no +fi +rm -f conftest* +fi + + if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then + cat >> confdefs.h <<\EOF +#define HAVE_STRUCT_DIRENT64 1 +EOF + + fi + echo "$ac_t""${tcl_cv_struct_dirent64}" 1>&6 + + echo $ac_n "checking for struct stat64""... $ac_c" 1>&6 +echo "configure:1511: checking for struct stat64" >&5 + if eval "test \"`echo '$''{'tcl_cv_struct_stat64'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + cat > conftest.$ac_ext <<EOF +#line 1517 "configure" +#include "confdefs.h" +#include <sys/stat.h> +int main() { +struct stat64 p; + +; return 0; } +EOF +if { (eval echo configure:1525: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + tcl_cv_struct_stat64=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + tcl_cv_struct_stat64=no +fi +rm -f conftest* +fi + + if test "x${tcl_cv_struct_stat64}" = "xyes" ; then + cat >> confdefs.h <<\EOF +#define HAVE_STRUCT_STAT64 1 +EOF + + fi + echo "$ac_t""${tcl_cv_struct_stat64}" 1>&6 + + echo $ac_n "checking for off64_t""... $ac_c" 1>&6 +echo "configure:1546: checking for off64_t" >&5 + if eval "test \"`echo '$''{'tcl_cv_type_off64_t'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + cat > conftest.$ac_ext <<EOF +#line 1552 "configure" +#include "confdefs.h" +#include <sys/types.h> +int main() { +off64_t offset; + +; return 0; } +EOF +if { (eval echo configure:1560: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + tcl_cv_type_off64_t=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + tcl_cv_type_off64_t=no +fi +rm -f conftest* +fi + + if test "x${tcl_cv_type_off64_t}" = "xyes" ; then + cat >> confdefs.h <<\EOF +#define HAVE_TYPE_OFF64_T 1 +EOF + + fi + echo "$ac_t""${tcl_cv_type_off64_t}" 1>&6 + fi + +#-------------------------------------------------------------------- # Supply substitutes for missing POSIX library procedures, or # set flags so Tcl uses alternate procedures. #-------------------------------------------------------------------- @@ -1311,12 +1586,12 @@ fi for ac_func in getcwd do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1315: checking for $ac_func" >&5 +echo "configure:1590: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1320 "configure" +#line 1595 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1339,7 +1614,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1343: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1618: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1373,12 +1648,12 @@ done for ac_func in opendir strstr do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1377: checking for $ac_func" >&5 +echo "configure:1652: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1382 "configure" +#line 1657 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1401,7 +1676,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1405: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1680: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1428,15 +1703,15 @@ done -for ac_func in strtol tmpnam waitpid +for ac_func in strtol strtoll strtoull tmpnam waitpid do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:1435: checking for $ac_func" >&5 +echo "configure:1710: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1440 "configure" +#line 1715 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -1459,7 +1734,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:1463: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1738: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -1486,12 +1761,12 @@ done echo $ac_n "checking for strerror""... $ac_c" 1>&6 -echo "configure:1490: checking for strerror" >&5 +echo "configure:1765: checking for strerror" >&5 if eval "test \"`echo '$''{'ac_cv_func_strerror'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1495 "configure" +#line 1770 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strerror(); below. */ @@ -1514,7 +1789,7 @@ strerror(); ; return 0; } EOF -if { (eval echo configure:1518: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1793: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_strerror=yes" else @@ -1538,12 +1813,12 @@ EOF fi echo $ac_n "checking for getwd""... $ac_c" 1>&6 -echo "configure:1542: checking for getwd" >&5 +echo "configure:1817: checking for getwd" >&5 if eval "test \"`echo '$''{'ac_cv_func_getwd'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1547 "configure" +#line 1822 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char getwd(); below. */ @@ -1566,7 +1841,7 @@ getwd(); ; return 0; } EOF -if { (eval echo configure:1570: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1845: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_getwd=yes" else @@ -1590,12 +1865,12 @@ EOF fi echo $ac_n "checking for wait3""... $ac_c" 1>&6 -echo "configure:1594: checking for wait3" >&5 +echo "configure:1869: checking for wait3" >&5 if eval "test \"`echo '$''{'ac_cv_func_wait3'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1599 "configure" +#line 1874 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char wait3(); below. */ @@ -1618,7 +1893,7 @@ wait3(); ; return 0; } EOF -if { (eval echo configure:1622: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1897: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_wait3=yes" else @@ -1642,12 +1917,12 @@ EOF fi echo $ac_n "checking for uname""... $ac_c" 1>&6 -echo "configure:1646: checking for uname" >&5 +echo "configure:1921: checking for uname" >&5 if eval "test \"`echo '$''{'ac_cv_func_uname'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1651 "configure" +#line 1926 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char uname(); below. */ @@ -1670,7 +1945,7 @@ uname(); ; return 0; } EOF -if { (eval echo configure:1674: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:1949: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_uname=yes" else @@ -1694,12 +1969,12 @@ EOF fi echo $ac_n "checking for realpath""... $ac_c" 1>&6 -echo "configure:1698: checking for realpath" >&5 +echo "configure:1973: checking for realpath" >&5 if eval "test \"`echo '$''{'ac_cv_func_realpath'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1703 "configure" +#line 1978 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char realpath(); below. */ @@ -1722,7 +1997,7 @@ realpath(); ; return 0; } EOF -if { (eval echo configure:1726: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2001: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_realpath=yes" else @@ -1758,9 +2033,9 @@ fi echo $ac_n "checking dirent.h""... $ac_c" 1>&6 -echo "configure:1762: checking dirent.h" >&5 +echo "configure:2037: checking dirent.h" >&5 cat > conftest.$ac_ext <<EOF -#line 1764 "configure" +#line 2039 "configure" #include "confdefs.h" #include <sys/types.h> #include <dirent.h> @@ -1786,7 +2061,7 @@ closedir(d); ; return 0; } EOF -if { (eval echo configure:1790: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2065: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* tcl_ok=yes else @@ -1807,17 +2082,17 @@ EOF echo "$ac_t""$tcl_ok" 1>&6 ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for errno.h""... $ac_c" 1>&6 -echo "configure:1811: checking for errno.h" >&5 +echo "configure:2086: checking for errno.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1816 "configure" +#line 2091 "configure" #include "confdefs.h" #include <errno.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1821: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2096: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -1844,17 +2119,17 @@ fi ac_safe=`echo "float.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for float.h""... $ac_c" 1>&6 -echo "configure:1848: checking for float.h" >&5 +echo "configure:2123: checking for float.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1853 "configure" +#line 2128 "configure" #include "confdefs.h" #include <float.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1858: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2133: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -1881,17 +2156,17 @@ fi ac_safe=`echo "values.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for values.h""... $ac_c" 1>&6 -echo "configure:1885: checking for values.h" >&5 +echo "configure:2160: checking for values.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1890 "configure" +#line 2165 "configure" #include "confdefs.h" #include <values.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1895: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2170: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -1918,17 +2193,17 @@ fi ac_safe=`echo "limits.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for limits.h""... $ac_c" 1>&6 -echo "configure:1922: checking for limits.h" >&5 +echo "configure:2197: checking for limits.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1927 "configure" +#line 2202 "configure" #include "confdefs.h" #include <limits.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1932: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2207: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -1955,17 +2230,17 @@ fi ac_safe=`echo "stdlib.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdlib.h""... $ac_c" 1>&6 -echo "configure:1959: checking for stdlib.h" >&5 +echo "configure:2234: checking for stdlib.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 1964 "configure" +#line 2239 "configure" #include "confdefs.h" #include <stdlib.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1969: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2244: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -1988,7 +2263,7 @@ tcl_ok=0 fi cat > conftest.$ac_ext <<EOF -#line 1992 "configure" +#line 2267 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -2002,7 +2277,7 @@ fi rm -f conftest* cat > conftest.$ac_ext <<EOF -#line 2006 "configure" +#line 2281 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -2016,7 +2291,7 @@ fi rm -f conftest* cat > conftest.$ac_ext <<EOF -#line 2020 "configure" +#line 2295 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -2037,17 +2312,17 @@ EOF fi ac_safe=`echo "string.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for string.h""... $ac_c" 1>&6 -echo "configure:2041: checking for string.h" >&5 +echo "configure:2316: checking for string.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2046 "configure" +#line 2321 "configure" #include "confdefs.h" #include <string.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2051: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2326: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -2070,7 +2345,7 @@ tcl_ok=0 fi cat > conftest.$ac_ext <<EOF -#line 2074 "configure" +#line 2349 "configure" #include "confdefs.h" #include <string.h> EOF @@ -2084,7 +2359,7 @@ fi rm -f conftest* cat > conftest.$ac_ext <<EOF -#line 2088 "configure" +#line 2363 "configure" #include "confdefs.h" #include <string.h> EOF @@ -2110,17 +2385,17 @@ EOF ac_safe=`echo "sys/wait.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/wait.h""... $ac_c" 1>&6 -echo "configure:2114: checking for sys/wait.h" >&5 +echo "configure:2389: checking for sys/wait.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2119 "configure" +#line 2394 "configure" #include "confdefs.h" #include <sys/wait.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2124: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2399: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -2147,17 +2422,17 @@ fi ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6 -echo "configure:2151: checking for dlfcn.h" >&5 +echo "configure:2426: checking for dlfcn.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2156 "configure" +#line 2431 "configure" #include "confdefs.h" #include <dlfcn.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2161: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2436: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -2189,17 +2464,17 @@ fi do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2193: checking for $ac_hdr" >&5 +echo "configure:2468: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2198 "configure" +#line 2473 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2203: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2478: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -2236,19 +2511,21 @@ done echo $ac_n "checking termios vs. termio vs. sgtty""... $ac_c" 1>&6 -echo "configure:2240: checking termios vs. termio vs. sgtty" >&5 - +echo "configure:2515: checking termios vs. termio vs. sgtty" >&5 + if eval "test \"`echo '$''{'tcl_cv_api_serial'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test "$cross_compiling" = yes; then - tk_ok=no + tcl_cv_api_serial=no else cat > conftest.$ac_ext <<EOF -#line 2246 "configure" +#line 2524 "configure" #include "confdefs.h" #include <termios.h> -main() -{ +int main() { struct termios t; if (tcgetattr(0, &t) == 0) { cfsetospeed(&t, 0); @@ -2258,74 +2535,61 @@ main() return 1; } EOF -if { (eval echo configure:2262: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:2539: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then - tk_ok=termios + tcl_cv_api_serial=termios else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* - tk_ok=no + tcl_cv_api_serial=no fi rm -fr conftest* fi - - if test $tk_ok = termios; then - cat >> confdefs.h <<\EOF -#define USE_TERMIOS 1 -EOF - - else + if test $tcl_cv_api_serial = no ; then if test "$cross_compiling" = yes; then - tk_ok=no + tcl_cv_api_serial=no else cat > conftest.$ac_ext <<EOF -#line 2285 "configure" +#line 2556 "configure" #include "confdefs.h" #include <termio.h> -main() -{ +int main() { struct termio t; if (ioctl(0, TCGETA, &t) == 0) { t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; return 0; } return 1; - } +} EOF -if { (eval echo configure:2300: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:2570: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then - tk_ok=termio + tcl_cv_api_serial=termio else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* - tk_ok=no + tcl_cv_api_serial=no fi rm -fr conftest* fi - - if test $tk_ok = termio; then - cat >> confdefs.h <<\EOF -#define USE_TERMIO 1 -EOF - - else + fi + if test $tcl_cv_api_serial = no ; then if test "$cross_compiling" = yes; then - tk_ok=none + tcl_cv_api_serial=none else cat > conftest.$ac_ext <<EOF -#line 2323 "configure" +#line 2588 "configure" #include "confdefs.h" #include <sgtty.h> -main() -{ +int main() { struct sgttyb t; if (ioctl(0, TIOCGETP, &t) == 0) { t.sg_ospeed = 0; @@ -2335,37 +2599,31 @@ main() return 1; } EOF -if { (eval echo configure:2339: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:2603: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then - tk_ok=sgtty + tcl_cv_api_serial=sgtty else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* - tk_ok=none + tcl_cv_api_serial=none fi rm -fr conftest* fi - - if test $tk_ok = sgtty; then - cat >> confdefs.h <<\EOF -#define USE_SGTTY 1 -EOF - - else + fi + if test $tcl_cv_api_serial = no ; then if test "$cross_compiling" = yes; then - tk_ok=no + tcl_cv_api_serial=no else cat > conftest.$ac_ext <<EOF -#line 2362 "configure" +#line 2621 "configure" #include "confdefs.h" #include <termios.h> #include <errno.h> -main() -{ +int main() { struct termios t; if (tcgetattr(0, &t) == 0 || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { @@ -2376,37 +2634,31 @@ main() return 1; } EOF -if { (eval echo configure:2380: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:2638: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then - tk_ok=termios + tcl_cv_api_serial=termios else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* - tk_ok=no + tcl_cv_api_serial=no fi rm -fr conftest* fi - - if test $tk_ok = termios; then - cat >> confdefs.h <<\EOF -#define USE_TERMIOS 1 -EOF - - else + fi + if test $tcl_cv_api_serial = no; then if test "$cross_compiling" = yes; then - tk_ok=no + tcl_cv_api_serial=no else cat > conftest.$ac_ext <<EOF -#line 2403 "configure" +#line 2656 "configure" #include "confdefs.h" #include <termio.h> #include <errno.h> -main() -{ +int main() { struct termio t; if (ioctl(0, TCGETA, &t) == 0 || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { @@ -2416,37 +2668,31 @@ main() return 1; } EOF -if { (eval echo configure:2420: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:2672: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then - tk_ok=termio + tcl_cv_api_serial=termio else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* - tk_ok=no + tcl_cv_api_serial=no fi rm -fr conftest* fi - - if test $tk_ok = termio; then - cat >> confdefs.h <<\EOF -#define USE_TERMIO 1 -EOF - - else + fi + if test $tcl_cv_api_serial = no; then if test "$cross_compiling" = yes; then - tk_ok=none + tcl_cv_api_serial=none else cat > conftest.$ac_ext <<EOF -#line 2443 "configure" +#line 2690 "configure" #include "confdefs.h" #include <sgtty.h> #include <errno.h> -main() -{ +int main() { struct sgttyb t; if (ioctl(0, TIOCGETP, &t) == 0 || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { @@ -2457,31 +2703,36 @@ main() return 1; } EOF -if { (eval echo configure:2461: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:2707: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then - tk_ok=sgtty + tcl_cv_api_serial=sgtty else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* - tk_ok=none + tcl_cv_api_serial=none fi rm -fr conftest* fi + fi +fi - if test $tk_ok = sgtty; then - cat >> confdefs.h <<\EOF + case $tcl_cv_api_serial in + termios) cat >> confdefs.h <<\EOF +#define USE_TERMIOS 1 +EOF +;; + termio) cat >> confdefs.h <<\EOF +#define USE_TERMIO 1 +EOF +;; + sgtty) cat >> confdefs.h <<\EOF #define USE_SGTTY 1 EOF - - fi - fi - fi - fi - fi - fi - echo "$ac_t""$tk_ok" 1>&6 +;; + esac + echo "$ac_t""$tcl_cv_api_serial" 1>&6 #-------------------------------------------------------------------- @@ -2494,47 +2745,65 @@ EOF # special flag. #-------------------------------------------------------------------- -echo $ac_n "checking fd_set and sys/select""... $ac_c" 1>&6 -echo "configure:2499: checking fd_set and sys/select" >&5 -cat > conftest.$ac_ext <<EOF -#line 2501 "configure" +echo $ac_n "checking for fd_set in sys/types""... $ac_c" 1>&6 +echo "configure:2750: checking for fd_set in sys/types" >&5 +if eval "test \"`echo '$''{'tcl_cv_type_fd_set'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 2755 "configure" #include "confdefs.h" #include <sys/types.h> int main() { fd_set readMask, writeMask; ; return 0; } EOF -if { (eval echo configure:2508: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2762: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* - tk_ok=yes + tcl_cv_type_fd_set=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* - tk_ok=no + tcl_cv_type_fd_set=no fi rm -f conftest* -if test $tk_ok = no; then - cat > conftest.$ac_ext <<EOF -#line 2520 "configure" +fi + +echo "$ac_t""$tcl_cv_type_fd_set" 1>&6 +tk_ok=$tcl_cv_type_fd_set +if test $tcl_cv_type_fd_set = no; then + echo $ac_n "checking for fd_mask in sys/select""... $ac_c" 1>&6 +echo "configure:2778: checking for fd_mask in sys/select" >&5 + if eval "test \"`echo '$''{'tcl_cv_grep_fd_mask'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 2783 "configure" #include "confdefs.h" #include <sys/select.h> EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | egrep "fd_mask" >/dev/null 2>&1; then rm -rf conftest* - tk_ok=yes + tcl_cv_grep_fd_mask=present +else + rm -rf conftest* + tcl_cv_grep_fd_mask=missing fi rm -f conftest* - if test $tk_ok = yes; then +fi + + echo "$ac_t""$tcl_cv_grep_fd_mask" 1>&6 + if test $tcl_cv_grep_fd_mask = present; then cat >> confdefs.h <<\EOF #define HAVE_SYS_SELECT_H 1 EOF + tk_ok=yes fi fi -echo "$ac_t""$tk_ok" 1>&6 if test $tk_ok = no; then cat >> confdefs.h <<\EOF #define NO_FD_SET 1 @@ -2547,12 +2816,12 @@ fi #------------------------------------------------------------------------------ echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 -echo "configure:2551: checking whether struct tm is in sys/time.h or time.h" >&5 +echo "configure:2820: checking whether struct tm is in sys/time.h or time.h" >&5 if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2556 "configure" +#line 2825 "configure" #include "confdefs.h" #include <sys/types.h> #include <time.h> @@ -2560,7 +2829,7 @@ int main() { struct tm *tp; tp->tm_sec; ; return 0; } EOF -if { (eval echo configure:2564: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2833: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h else @@ -2585,17 +2854,17 @@ fi do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2589: checking for $ac_hdr" >&5 +echo "configure:2858: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2594 "configure" +#line 2863 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2599: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2868: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -2622,12 +2891,12 @@ fi done echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 -echo "configure:2626: checking whether time.h and sys/time.h may both be included" >&5 +echo "configure:2895: checking whether time.h and sys/time.h may both be included" >&5 if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2631 "configure" +#line 2900 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/time.h> @@ -2636,7 +2905,7 @@ int main() { struct tm *tp; ; return 0; } EOF -if { (eval echo configure:2640: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2909: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else @@ -2657,12 +2926,12 @@ EOF fi echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6 -echo "configure:2661: checking for tm_zone in struct tm" >&5 +echo "configure:2930: checking for tm_zone in struct tm" >&5 if eval "test \"`echo '$''{'ac_cv_struct_tm_zone'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2666 "configure" +#line 2935 "configure" #include "confdefs.h" #include <sys/types.h> #include <$ac_cv_struct_tm> @@ -2670,7 +2939,7 @@ int main() { struct tm tm; tm.tm_zone; ; return 0; } EOF -if { (eval echo configure:2674: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2943: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm_zone=yes else @@ -2690,12 +2959,12 @@ EOF else echo $ac_n "checking for tzname""... $ac_c" 1>&6 -echo "configure:2694: checking for tzname" >&5 +echo "configure:2963: checking for tzname" >&5 if eval "test \"`echo '$''{'ac_cv_var_tzname'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2699 "configure" +#line 2968 "configure" #include "confdefs.h" #include <time.h> #ifndef tzname /* For SGI. */ @@ -2705,7 +2974,7 @@ int main() { atoi(*tzname); ; return 0; } EOF -if { (eval echo configure:2709: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:2978: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* ac_cv_var_tzname=yes else @@ -2730,12 +2999,12 @@ fi for ac_func in gmtime_r localtime_r do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:2734: checking for $ac_func" >&5 +echo "configure:3003: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2739 "configure" +#line 3008 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $ac_func(); below. */ @@ -2758,7 +3027,7 @@ $ac_func(); ; return 0; } EOF -if { (eval echo configure:2762: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3031: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -2784,64 +3053,82 @@ done echo $ac_n "checking tm_tzadj in struct tm""... $ac_c" 1>&6 -echo "configure:2788: checking tm_tzadj in struct tm" >&5 - cat > conftest.$ac_ext <<EOF -#line 2790 "configure" +echo "configure:3057: checking tm_tzadj in struct tm" >&5 + if eval "test \"`echo '$''{'tcl_cv_member_tm_tzadj'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 3062 "configure" #include "confdefs.h" #include <time.h> int main() { struct tm tm; tm.tm_tzadj; ; return 0; } EOF -if { (eval echo configure:2797: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3069: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* - cat >> confdefs.h <<\EOF -#define HAVE_TM_TZADJ 1 -EOF - - echo "$ac_t""yes" 1>&6 + tcl_cv_member_tm_tzadj=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* - echo "$ac_t""no" 1>&6 + tcl_cv_member_tm_tzadj=no fi rm -f conftest* +fi + + echo "$ac_t""$tcl_cv_member_tm_tzadj" 1>&6 + if test $tcl_cv_member_tm_tzadj = yes ; then + cat >> confdefs.h <<\EOF +#define HAVE_TM_TZADJ 1 +EOF + + fi echo $ac_n "checking tm_gmtoff in struct tm""... $ac_c" 1>&6 -echo "configure:2813: checking tm_gmtoff in struct tm" >&5 - cat > conftest.$ac_ext <<EOF -#line 2815 "configure" +echo "configure:3090: checking tm_gmtoff in struct tm" >&5 + if eval "test \"`echo '$''{'tcl_cv_member_tm_gmtoff'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 3095 "configure" #include "confdefs.h" #include <time.h> int main() { struct tm tm; tm.tm_gmtoff; ; return 0; } EOF -if { (eval echo configure:2822: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3102: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* - cat >> confdefs.h <<\EOF -#define HAVE_TM_GMTOFF 1 -EOF - - echo "$ac_t""yes" 1>&6 + tcl_cv_member_tm_gmtoff=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* - echo "$ac_t""no" 1>&6 + tcl_cv_member_tm_gmtoff=no fi rm -f conftest* +fi + + echo "$ac_t""$tcl_cv_member_tm_gmtoff" 1>&6 + if test $tcl_cv_member_tm_gmtoff = yes ; then + cat >> confdefs.h <<\EOF +#define HAVE_TM_GMTOFF 1 +EOF + + fi # # Its important to include time.h in this check, as some systems # (like convex) have timezone functions, etc. # - have_timezone=no echo $ac_n "checking long timezone variable""... $ac_c" 1>&6 -echo "configure:2843: checking long timezone variable" >&5 - cat > conftest.$ac_ext <<EOF -#line 2845 "configure" +echo "configure:3127: checking long timezone variable" >&5 + if eval "test \"`echo '$''{'tcl_cv_var_timezone'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 3132 "configure" #include "confdefs.h" #include <time.h> int main() { @@ -2850,54 +3137,63 @@ extern long timezone; exit (0); ; return 0; } EOF -if { (eval echo configure:2854: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3141: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* - have_timezone=yes - cat >> confdefs.h <<\EOF -#define HAVE_TIMEZONE_VAR 1 -EOF - - echo "$ac_t""yes" 1>&6 + tcl_cv_timezone_long=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* - echo "$ac_t""no" 1>&6 + tcl_cv_timezone_long=no fi rm -f conftest* +fi - # - # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. - # - if test "$have_timezone" = no; then - echo $ac_n "checking time_t timezone variable""... $ac_c" 1>&6 -echo "configure:2875: checking time_t timezone variable" >&5 - cat > conftest.$ac_ext <<EOF -#line 2877 "configure" + echo "$ac_t""$tcl_cv_timezone_long" 1>&6 + if test $tcl_cv_timezone_long = yes ; then + cat >> confdefs.h <<\EOF +#define HAVE_TIMEZONE_VAR 1 +EOF + + else + # + # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. + # + echo $ac_n "checking time_t timezone variable""... $ac_c" 1>&6 +echo "configure:3164: checking time_t timezone variable" >&5 + if eval "test \"`echo '$''{'tcl_cv_timezone_time'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 3169 "configure" #include "confdefs.h" #include <time.h> int main() { extern time_t timezone; - timezone += 1; - exit (0); + timezone += 1; + exit (0); ; return 0; } EOF -if { (eval echo configure:2886: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3178: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* - cat >> confdefs.h <<\EOF -#define HAVE_TIMEZONE_VAR 1 -EOF - - echo "$ac_t""yes" 1>&6 + tcl_cv_timezone_time=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* - echo "$ac_t""no" 1>&6 + tcl_cv_timezone_time=no fi rm -f conftest* - fi +fi + + echo "$ac_t""$tcl_cv_timezone_time" 1>&6 + if test $tcl_cv_timezone_time = yes ; then + cat >> confdefs.h <<\EOF +#define HAVE_TIMEZONE_VAR 1 +EOF + fi + fi #-------------------------------------------------------------------- @@ -2905,12 +3201,12 @@ rm -f conftest* # in struct stat. But we might be able to use fstatfs instead. #-------------------------------------------------------------------- echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6 -echo "configure:2909: checking for st_blksize in struct stat" >&5 +echo "configure:3205: checking for st_blksize in struct stat" >&5 if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2914 "configure" +#line 3210 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/stat.h> @@ -2918,7 +3214,7 @@ int main() { struct stat s; s.st_blksize; ; return 0; } EOF -if { (eval echo configure:2922: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3218: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_st_blksize=yes else @@ -2939,12 +3235,12 @@ EOF fi echo $ac_n "checking for fstatfs""... $ac_c" 1>&6 -echo "configure:2943: checking for fstatfs" >&5 +echo "configure:3239: checking for fstatfs" >&5 if eval "test \"`echo '$''{'ac_cv_func_fstatfs'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 2948 "configure" +#line 3244 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char fstatfs(); below. */ @@ -2967,7 +3263,7 @@ fstatfs(); ; return 0; } EOF -if { (eval echo configure:2971: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3267: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_fstatfs=yes" else @@ -2996,7 +3292,7 @@ fi # data, this checks it and add memcmp.o to LIBOBJS if needed #-------------------------------------------------------------------- echo $ac_n "checking for 8-bit clean memcmp""... $ac_c" 1>&6 -echo "configure:3000: checking for 8-bit clean memcmp" >&5 +echo "configure:3296: checking for 8-bit clean memcmp" >&5 if eval "test \"`echo '$''{'ac_cv_func_memcmp_clean'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -3004,7 +3300,7 @@ else ac_cv_func_memcmp_clean=no else cat > conftest.$ac_ext <<EOF -#line 3008 "configure" +#line 3304 "configure" #include "confdefs.h" main() @@ -3014,7 +3310,7 @@ main() } EOF -if { (eval echo configure:3018: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:3314: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then ac_cv_func_memcmp_clean=yes else @@ -3038,12 +3334,12 @@ test $ac_cv_func_memcmp_clean = no && LIBOBJS="$LIBOBJS memcmp.${ac_objext}" # {The replacement define is in compat/string.h} #-------------------------------------------------------------------- echo $ac_n "checking for memmove""... $ac_c" 1>&6 -echo "configure:3042: checking for memmove" >&5 +echo "configure:3338: checking for memmove" >&5 if eval "test \"`echo '$''{'ac_cv_func_memmove'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3047 "configure" +#line 3343 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char memmove(); below. */ @@ -3066,7 +3362,7 @@ memmove(); ; return 0; } EOF -if { (eval echo configure:3070: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3366: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_memmove=yes" else @@ -3099,12 +3395,12 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking proper strstr implementation""... $ac_c" 1>&6 -echo "configure:3103: checking proper strstr implementation" >&5 +echo "configure:3399: checking proper strstr implementation" >&5 if test "$cross_compiling" = yes; then tcl_ok=no else cat > conftest.$ac_ext <<EOF -#line 3108 "configure" +#line 3404 "configure" #include "confdefs.h" extern int strstr(); @@ -3114,7 +3410,7 @@ int main() } EOF -if { (eval echo configure:3118: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:3414: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then tcl_ok=yes else @@ -3140,12 +3436,12 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking for strtoul""... $ac_c" 1>&6 -echo "configure:3144: checking for strtoul" >&5 +echo "configure:3440: checking for strtoul" >&5 if eval "test \"`echo '$''{'ac_cv_func_strtoul'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3149 "configure" +#line 3445 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strtoul(); below. */ @@ -3168,7 +3464,7 @@ strtoul(); ; return 0; } EOF -if { (eval echo configure:3172: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3468: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_strtoul=yes" else @@ -3192,7 +3488,7 @@ if test "$cross_compiling" = yes; then tcl_ok=0 else cat > conftest.$ac_ext <<EOF -#line 3196 "configure" +#line 3492 "configure" #include "confdefs.h" extern int strtoul(); @@ -3208,7 +3504,7 @@ int main() exit(0); } EOF -if { (eval echo configure:3212: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:3508: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then : else @@ -3231,12 +3527,12 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking for strtod""... $ac_c" 1>&6 -echo "configure:3235: checking for strtod" >&5 +echo "configure:3531: checking for strtod" >&5 if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3240 "configure" +#line 3536 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strtod(); below. */ @@ -3259,7 +3555,7 @@ strtod(); ; return 0; } EOF -if { (eval echo configure:3263: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3559: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_strtod=yes" else @@ -3283,7 +3579,7 @@ if test "$cross_compiling" = yes; then tcl_ok=0 else cat > conftest.$ac_ext <<EOF -#line 3287 "configure" +#line 3583 "configure" #include "confdefs.h" extern double strtod(); @@ -3299,7 +3595,7 @@ int main() exit(0); } EOF -if { (eval echo configure:3303: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:3599: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then : else @@ -3325,12 +3621,12 @@ fi echo $ac_n "checking for strtod""... $ac_c" 1>&6 -echo "configure:3329: checking for strtod" >&5 +echo "configure:3625: checking for strtod" >&5 if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3334 "configure" +#line 3630 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strtod(); below. */ @@ -3353,7 +3649,7 @@ strtod(); ; return 0; } EOF -if { (eval echo configure:3357: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:3653: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_strtod=yes" else @@ -3375,12 +3671,12 @@ fi if test "$tcl_strtod" = 1; then echo $ac_n "checking for Solaris2.4/Tru64 strtod bugs""... $ac_c" 1>&6 -echo "configure:3379: checking for Solaris2.4/Tru64 strtod bugs" >&5 +echo "configure:3675: checking for Solaris2.4/Tru64 strtod bugs" >&5 if test "$cross_compiling" = yes; then tcl_ok=0 else cat > conftest.$ac_ext <<EOF -#line 3384 "configure" +#line 3680 "configure" #include "confdefs.h" extern double strtod(); @@ -3400,7 +3696,7 @@ else exit(0); } EOF -if { (eval echo configure:3404: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:3700: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then tcl_ok=1 else @@ -3431,12 +3727,12 @@ EOF #-------------------------------------------------------------------- echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:3435: checking for ANSI C header files" >&5 +echo "configure:3731: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3440 "configure" +#line 3736 "configure" #include "confdefs.h" #include <stdlib.h> #include <stdarg.h> @@ -3444,7 +3740,7 @@ else #include <float.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3448: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:3744: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -3461,7 +3757,7 @@ rm -f conftest* if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 3465 "configure" +#line 3761 "configure" #include "confdefs.h" #include <string.h> EOF @@ -3479,7 +3775,7 @@ fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext <<EOF -#line 3483 "configure" +#line 3779 "configure" #include "confdefs.h" #include <stdlib.h> EOF @@ -3500,7 +3796,7 @@ if test "$cross_compiling" = yes; then : else cat > conftest.$ac_ext <<EOF -#line 3504 "configure" +#line 3800 "configure" #include "confdefs.h" #include <ctype.h> #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') @@ -3511,7 +3807,7 @@ if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } EOF -if { (eval echo configure:3515: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:3811: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then : else @@ -3535,12 +3831,12 @@ EOF fi echo $ac_n "checking for mode_t""... $ac_c" 1>&6 -echo "configure:3539: checking for mode_t" >&5 +echo "configure:3835: checking for mode_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3544 "configure" +#line 3840 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -3568,12 +3864,12 @@ EOF fi echo $ac_n "checking for pid_t""... $ac_c" 1>&6 -echo "configure:3572: checking for pid_t" >&5 +echo "configure:3868: checking for pid_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3577 "configure" +#line 3873 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -3601,12 +3897,12 @@ EOF fi echo $ac_n "checking for size_t""... $ac_c" 1>&6 -echo "configure:3605: checking for size_t" >&5 +echo "configure:3901: checking for size_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3610 "configure" +#line 3906 "configure" #include "confdefs.h" #include <sys/types.h> #if STDC_HEADERS @@ -3634,12 +3930,12 @@ EOF fi echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6 -echo "configure:3638: checking for uid_t in sys/types.h" >&5 +echo "configure:3934: checking for uid_t in sys/types.h" >&5 if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3643 "configure" +#line 3939 "configure" #include "confdefs.h" #include <sys/types.h> EOF @@ -3676,12 +3972,12 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking for opendir""... $ac_c" 1>&6 -echo "configure:3680: checking for opendir" >&5 +echo "configure:3976: checking for opendir" >&5 if eval "test \"`echo '$''{'ac_cv_func_opendir'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3685 "configure" +#line 3981 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char opendir(); below. */ @@ -3704,7 +4000,7 @@ opendir(); ; return 0; } EOF -if { (eval echo configure:3708: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4004: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_opendir=yes" else @@ -3737,9 +4033,12 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking union wait""... $ac_c" 1>&6 -echo "configure:3741: checking union wait" >&5 -cat > conftest.$ac_ext <<EOF -#line 3743 "configure" +echo "configure:4037: checking union wait" >&5 +if eval "test \"`echo '$''{'tcl_cv_union_wait'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 4042 "configure" #include "confdefs.h" #include <sys/types.h> #include <sys/wait.h> @@ -3748,21 +4047,23 @@ int main() { union wait x; WIFEXITED(x); /* Generates compiler error if WIFEXITED * uses an int. */ - + ; return 0; } EOF -if { (eval echo configure:3755: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4054: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* - tcl_ok=yes + tcl_cv_union_wait=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* - tcl_ok=no + tcl_cv_union_wait=no fi rm -f conftest* -echo "$ac_t""$tcl_ok" 1>&6 -if test $tcl_ok = no; then +fi + +echo "$ac_t""$tcl_cv_union_wait" 1>&6 +if test $tcl_cv_union_wait = no; then cat >> confdefs.h <<\EOF #define NO_UNION_WAIT 1 EOF @@ -3775,31 +4076,36 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking matherr support""... $ac_c" 1>&6 -echo "configure:3779: checking matherr support" >&5 -cat > conftest.$ac_ext <<EOF -#line 3781 "configure" +echo "configure:4080: checking matherr support" >&5 +if eval "test \"`echo '$''{'tcl_cv_func_matherr'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 4085 "configure" #include "confdefs.h" #include <math.h> int main() { -struct exception x; -x.type = DOMAIN; -x.type = SING; - + struct exception x; + x.type = DOMAIN; + x.type = SING; + ; return 0; } EOF -if { (eval echo configure:3792: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:4096: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* - tcl_ok=yes + tcl_cv_func_matherr=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* - tcl_ok=no + tcl_cv_func_matherr=no fi rm -f conftest* -echo "$ac_t""$tcl_ok" 1>&6 -if test $tcl_ok = yes; then +fi + +echo "$ac_t""$tcl_cv_func_matherr" 1>&6 +if test $tcl_cv_func_matherr = yes; then cat >> confdefs.h <<\EOF #define NEED_MATHERR 1 EOF @@ -3813,12 +4119,12 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking for strncasecmp""... $ac_c" 1>&6 -echo "configure:3817: checking for strncasecmp" >&5 +echo "configure:4123: checking for strncasecmp" >&5 if eval "test \"`echo '$''{'ac_cv_func_strncasecmp'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3822 "configure" +#line 4128 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char strncasecmp(); below. */ @@ -3841,7 +4147,7 @@ strncasecmp(); ; return 0; } EOF -if { (eval echo configure:3845: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4151: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_strncasecmp=yes" else @@ -3863,7 +4169,7 @@ fi if test "$tcl_ok" = 0; then echo $ac_n "checking for strncasecmp in -lsocket""... $ac_c" 1>&6 -echo "configure:3867: checking for strncasecmp in -lsocket" >&5 +echo "configure:4173: checking for strncasecmp in -lsocket" >&5 ac_lib_var=`echo socket'_'strncasecmp | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -3871,7 +4177,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lsocket $LIBS" cat > conftest.$ac_ext <<EOF -#line 3875 "configure" +#line 4181 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -3882,7 +4188,7 @@ int main() { strncasecmp() ; return 0; } EOF -if { (eval echo configure:3886: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4192: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3906,7 +4212,7 @@ fi fi if test "$tcl_ok" = 0; then echo $ac_n "checking for strncasecmp in -linet""... $ac_c" 1>&6 -echo "configure:3910: checking for strncasecmp in -linet" >&5 +echo "configure:4216: checking for strncasecmp in -linet" >&5 ac_lib_var=`echo inet'_'strncasecmp | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -3914,7 +4220,7 @@ else ac_save_LIBS="$LIBS" LIBS="-linet $LIBS" cat > conftest.$ac_ext <<EOF -#line 3918 "configure" +#line 4224 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -3925,7 +4231,7 @@ int main() { strncasecmp() ; return 0; } EOF -if { (eval echo configure:3929: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4235: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3963,12 +4269,12 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking for BSDgettimeofday""... $ac_c" 1>&6 -echo "configure:3967: checking for BSDgettimeofday" >&5 +echo "configure:4273: checking for BSDgettimeofday" >&5 if eval "test \"`echo '$''{'ac_cv_func_BSDgettimeofday'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 3972 "configure" +#line 4278 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char BSDgettimeofday(); below. */ @@ -3991,7 +4297,7 @@ BSDgettimeofday(); ; return 0; } EOF -if { (eval echo configure:3995: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4301: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_BSDgettimeofday=yes" else @@ -4013,12 +4319,12 @@ else echo "$ac_t""no" 1>&6 echo $ac_n "checking for gettimeofday""... $ac_c" 1>&6 -echo "configure:4017: checking for gettimeofday" >&5 +echo "configure:4323: checking for gettimeofday" >&5 if eval "test \"`echo '$''{'ac_cv_func_gettimeofday'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 4022 "configure" +#line 4328 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gettimeofday(); below. */ @@ -4041,7 +4347,7 @@ gettimeofday(); ; return 0; } EOF -if { (eval echo configure:4045: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4351: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_gettimeofday=yes" else @@ -4068,28 +4374,34 @@ fi fi echo $ac_n "checking for gettimeofday declaration""... $ac_c" 1>&6 -echo "configure:4072: checking for gettimeofday declaration" >&5 -cat > conftest.$ac_ext <<EOF -#line 4074 "configure" +echo "configure:4378: checking for gettimeofday declaration" >&5 +if eval "test \"`echo '$''{'tcl_cv_grep_gettimeofday'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 4383 "configure" #include "confdefs.h" #include <sys/time.h> EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | egrep "gettimeofday" >/dev/null 2>&1; then rm -rf conftest* - echo "$ac_t""present" 1>&6 + tcl_cv_grep_gettimeofday=present else rm -rf conftest* - - echo "$ac_t""missing" 1>&6 + tcl_cv_grep_gettimeofday=missing +fi +rm -f conftest* + +fi + +echo "$ac_t""$tcl_cv_grep_gettimeofday" 1>&6 +if test $tcl_cv_grep_gettimeofday = missing ; then cat >> confdefs.h <<\EOF #define GETTOD_NOT_DECLARED 1 EOF - fi -rm -f conftest* - #-------------------------------------------------------------------- # The following code checks to see whether it is possible to get @@ -4098,14 +4410,14 @@ rm -f conftest* #-------------------------------------------------------------------- echo $ac_n "checking whether char is unsigned""... $ac_c" 1>&6 -echo "configure:4102: checking whether char is unsigned" >&5 +echo "configure:4414: checking whether char is unsigned" >&5 if eval "test \"`echo '$''{'ac_cv_c_char_unsigned'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test "$GCC" = yes; then # GCC predefines this symbol on systems where it applies. cat > conftest.$ac_ext <<EOF -#line 4109 "configure" +#line 4421 "configure" #include "confdefs.h" #ifdef __CHAR_UNSIGNED__ yes @@ -4127,7 +4439,7 @@ if test "$cross_compiling" = yes; then { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; } else cat > conftest.$ac_ext <<EOF -#line 4131 "configure" +#line 4443 "configure" #include "confdefs.h" /* volatile prevents gcc2 from optimizing the test away on sparcs. */ #if !defined(__STDC__) || __STDC__ != 1 @@ -4137,7 +4449,7 @@ main() { volatile char c = 255; exit(c < 0); } EOF -if { (eval echo configure:4141: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +if { (eval echo configure:4453: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null then ac_cv_c_char_unsigned=yes else @@ -4161,30 +4473,35 @@ EOF fi echo $ac_n "checking signed char declarations""... $ac_c" 1>&6 -echo "configure:4165: checking signed char declarations" >&5 -cat > conftest.$ac_ext <<EOF -#line 4167 "configure" +echo "configure:4477: checking signed char declarations" >&5 +if eval "test \"`echo '$''{'tcl_cv_char_signed'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 4482 "configure" #include "confdefs.h" int main() { -signed char *p; -p = 0; - + signed char *p; + p = 0; + ; return 0; } EOF -if { (eval echo configure:4177: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:4492: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* - tcl_ok=yes + tcl_cv_char_signed=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* - tcl_ok=no + tcl_cv_char_signed=no fi rm -f conftest* -echo "$ac_t""$tcl_ok" 1>&6 -if test $tcl_ok = yes; then +fi + +echo "$ac_t""$tcl_cv_char_signed" 1>&6 +if test $tcl_cv_char_signed = yes; then cat >> confdefs.h <<\EOF #define HAVE_SIGNED_CHAR 1 EOF @@ -4210,17 +4527,17 @@ fi if test "$langinfo_ok" = "yes"; then ac_safe=`echo "langinfo.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for langinfo.h""... $ac_c" 1>&6 -echo "configure:4214: checking for langinfo.h" >&5 +echo "configure:4531: checking for langinfo.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 4219 "configure" +#line 4536 "configure" #include "confdefs.h" #include <langinfo.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4224: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:4541: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -4245,17 +4562,17 @@ fi fi fi echo $ac_n "checking whether to use nl_langinfo""... $ac_c" 1>&6 -echo "configure:4249: checking whether to use nl_langinfo" >&5 +echo "configure:4566: checking whether to use nl_langinfo" >&5 if test "$langinfo_ok" = "yes"; then cat > conftest.$ac_ext <<EOF -#line 4252 "configure" +#line 4569 "configure" #include "confdefs.h" #include <langinfo.h> int main() { nl_langinfo(CODESET); ; return 0; } EOF -if { (eval echo configure:4259: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:4576: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* langinfo_ok=yes else @@ -4291,12 +4608,12 @@ EOF #-------------------------------------------------------------------- echo $ac_n "checking for sin""... $ac_c" 1>&6 -echo "configure:4295: checking for sin" >&5 +echo "configure:4612: checking for sin" >&5 if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 4300 "configure" +#line 4617 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char sin(); below. */ @@ -4319,7 +4636,7 @@ sin(); ; return 0; } EOF -if { (eval echo configure:4323: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4640: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_sin=yes" else @@ -4340,7 +4657,7 @@ MATH_LIBS="-lm" fi echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6 -echo "configure:4344: checking for main in -lieee" >&5 +echo "configure:4661: checking for main in -lieee" >&5 ac_lib_var=`echo ieee'_'main | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -4348,14 +4665,14 @@ else ac_save_LIBS="$LIBS" LIBS="-lieee $LIBS" cat > conftest.$ac_ext <<EOF -#line 4352 "configure" +#line 4669 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:4359: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4676: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4382,7 +4699,7 @@ fi #-------------------------------------------------------------------- echo $ac_n "checking for main in -linet""... $ac_c" 1>&6 -echo "configure:4386: checking for main in -linet" >&5 +echo "configure:4703: checking for main in -linet" >&5 ac_lib_var=`echo inet'_'main | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -4390,14 +4707,14 @@ else ac_save_LIBS="$LIBS" LIBS="-linet $LIBS" cat > conftest.$ac_ext <<EOF -#line 4394 "configure" +#line 4711 "configure" #include "confdefs.h" int main() { main() ; return 0; } EOF -if { (eval echo configure:4401: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4718: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4419,17 +4736,17 @@ fi ac_safe=`echo "net/errno.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for net/errno.h""... $ac_c" 1>&6 -echo "configure:4423: checking for net/errno.h" >&5 +echo "configure:4740: checking for net/errno.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 4428 "configure" +#line 4745 "configure" #include "confdefs.h" #include <net/errno.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4433: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:4750: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -4474,12 +4791,12 @@ fi tcl_checkBoth=0 echo $ac_n "checking for connect""... $ac_c" 1>&6 -echo "configure:4478: checking for connect" >&5 +echo "configure:4795: checking for connect" >&5 if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 4483 "configure" +#line 4800 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char connect(); below. */ @@ -4502,7 +4819,7 @@ connect(); ; return 0; } EOF -if { (eval echo configure:4506: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4823: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_connect=yes" else @@ -4524,12 +4841,12 @@ fi if test "$tcl_checkSocket" = 1; then echo $ac_n "checking for setsockopt""... $ac_c" 1>&6 -echo "configure:4528: checking for setsockopt" >&5 +echo "configure:4845: checking for setsockopt" >&5 if eval "test \"`echo '$''{'ac_cv_func_setsockopt'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 4533 "configure" +#line 4850 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char setsockopt(); below. */ @@ -4552,7 +4869,7 @@ setsockopt(); ; return 0; } EOF -if { (eval echo configure:4556: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4873: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_setsockopt=yes" else @@ -4570,7 +4887,7 @@ if eval "test \"`echo '$ac_cv_func_'setsockopt`\" = yes"; then else echo "$ac_t""no" 1>&6 echo $ac_n "checking for setsockopt in -lsocket""... $ac_c" 1>&6 -echo "configure:4574: checking for setsockopt in -lsocket" >&5 +echo "configure:4891: checking for setsockopt in -lsocket" >&5 ac_lib_var=`echo socket'_'setsockopt | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -4578,7 +4895,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lsocket $LIBS" cat > conftest.$ac_ext <<EOF -#line 4582 "configure" +#line 4899 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4589,7 +4906,7 @@ int main() { setsockopt() ; return 0; } EOF -if { (eval echo configure:4593: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4910: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4617,12 +4934,12 @@ fi tk_oldLibs=$LIBS LIBS="$LIBS -lsocket -lnsl" echo $ac_n "checking for accept""... $ac_c" 1>&6 -echo "configure:4621: checking for accept" >&5 +echo "configure:4938: checking for accept" >&5 if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 4626 "configure" +#line 4943 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char accept(); below. */ @@ -4645,7 +4962,7 @@ accept(); ; return 0; } EOF -if { (eval echo configure:4649: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:4966: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_accept=yes" else @@ -4667,12 +4984,12 @@ fi fi echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 -echo "configure:4671: checking for gethostbyname" >&5 +echo "configure:4988: checking for gethostbyname" >&5 if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 4676 "configure" +#line 4993 "configure" #include "confdefs.h" /* System header to define __stub macros and hopefully few prototypes, which can conflict with char gethostbyname(); below. */ @@ -4695,7 +5012,7 @@ gethostbyname(); ; return 0; } EOF -if { (eval echo configure:4699: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5016: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_gethostbyname=yes" else @@ -4713,7 +5030,7 @@ if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then else echo "$ac_t""no" 1>&6 echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6 -echo "configure:4717: checking for gethostbyname in -lnsl" >&5 +echo "configure:5034: checking for gethostbyname in -lnsl" >&5 ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -4721,7 +5038,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lnsl $LIBS" cat > conftest.$ac_ext <<EOF -#line 4725 "configure" +#line 5042 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4732,7 +5049,7 @@ int main() { gethostbyname() ; return 0; } EOF -if { (eval echo configure:4736: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5053: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4778,7 +5095,7 @@ LIBS="$LIBS$THREADS_LIBS" # Step 0.a: Enable 64 bit support? echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6 -echo "configure:4782: checking if 64bit support is requested" >&5 +echo "configure:5099: checking if 64bit support is requested" >&5 # Check whether --enable-64bit or --disable-64bit was given. if test "${enable_64bit+set}" = set; then enableval="$enable_64bit" @@ -4798,7 +5115,7 @@ fi # Step 0.b: Enable Solaris 64 bit VIS support? echo $ac_n "checking if 64bit Sparc VIS support is requested""... $ac_c" 1>&6 -echo "configure:4802: checking if 64bit Sparc VIS support is requested" >&5 +echo "configure:5119: checking if 64bit Sparc VIS support is requested" >&5 # Check whether --enable-64bit-vis or --disable-64bit-vis was given. if test "${enable_64bit_vis+set}" = set; then enableval="$enable_64bit_vis" @@ -4822,7 +5139,7 @@ fi # there are a few systems, like Next, where this doesn't work. echo $ac_n "checking system version (for dynamic loading)""... $ac_c" 1>&6 -echo "configure:4826: checking system version (for dynamic loading)" >&5 +echo "configure:5143: checking system version (for dynamic loading)" >&5 if test -f /usr/lib/NextStep/software_version; then system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else @@ -4848,7 +5165,7 @@ echo "configure:4826: checking system version (for dynamic loading)" >&5 # Linux can use either -ldl or -ldld for dynamic loading. echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6 -echo "configure:4852: checking for dlopen in -ldl" >&5 +echo "configure:5169: checking for dlopen in -ldl" >&5 ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -4856,7 +5173,7 @@ else ac_save_LIBS="$LIBS" LIBS="-ldl $LIBS" cat > conftest.$ac_ext <<EOF -#line 4860 "configure" +#line 5177 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -4867,7 +5184,7 @@ int main() { dlopen() ; return 0; } EOF -if { (eval echo configure:4871: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5188: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4911,7 +5228,7 @@ fi # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:4915: checking for $ac_word" >&5 +echo "configure:5232: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -5016,7 +5333,7 @@ fi # known GMT value. echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6 -echo "configure:5020: checking for gettimeofday in -lbsd" >&5 +echo "configure:5337: checking for gettimeofday in -lbsd" >&5 ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -5024,7 +5341,7 @@ else ac_save_LIBS="$LIBS" LIBS="-lbsd $LIBS" cat > conftest.$ac_ext <<EOF -#line 5028 "configure" +#line 5345 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5035,7 +5352,7 @@ int main() { gettimeofday() ; return 0; } EOF -if { (eval echo configure:5039: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5356: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5097,7 +5414,7 @@ EOF HP-UX-*.11.*) SHLIB_SUFFIX=".sl" echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6 -echo "configure:5101: checking for shl_load in -ldld" >&5 +echo "configure:5418: checking for shl_load in -ldld" >&5 ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -5105,7 +5422,7 @@ else ac_save_LIBS="$LIBS" LIBS="-ldld $LIBS" cat > conftest.$ac_ext <<EOF -#line 5109 "configure" +#line 5426 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5116,7 +5433,7 @@ int main() { shl_load() ; return 0; } EOF -if { (eval echo configure:5120: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5437: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5159,7 +5476,7 @@ fi HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*) SHLIB_SUFFIX=".sl" echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6 -echo "configure:5163: checking for shl_load in -ldld" >&5 +echo "configure:5480: checking for shl_load in -ldld" >&5 ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 @@ -5167,7 +5484,7 @@ else ac_save_LIBS="$LIBS" LIBS="-ldld $LIBS" cat > conftest.$ac_ext <<EOF -#line 5171 "configure" +#line 5488 "configure" #include "confdefs.h" /* Override any gcc2 internal prototype to avoid an error. */ /* We use char because int might match the return type of a gcc2 @@ -5178,7 +5495,7 @@ int main() { shl_load() ; return 0; } EOF -if { (eval echo configure:5182: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:5499: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5285,17 +5602,17 @@ fi else ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for dld.h""... $ac_c" 1>&6 -echo "configure:5289: checking for dld.h" >&5 +echo "configure:5606: checking for dld.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 5294 "configure" +#line 5611 "configure" #include "confdefs.h" #include <dld.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5299: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5616: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -5352,17 +5669,17 @@ fi else ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for dld.h""... $ac_c" 1>&6 -echo "configure:5356: checking for dld.h" >&5 +echo "configure:5673: checking for dld.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 5361 "configure" +#line 5678 "configure" #include "confdefs.h" #include <dld.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5366: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5683: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -5417,17 +5734,17 @@ fi # Not available on all versions: check for include file. ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6 -echo "configure:5421: checking for dlfcn.h" >&5 +echo "configure:5738: checking for dlfcn.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 5426 "configure" +#line 5743 "configure" #include "confdefs.h" #include <dlfcn.h> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5431: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5748: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -5454,9 +5771,9 @@ if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then LDFLAGS="" LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' echo $ac_n "checking for ELF""... $ac_c" 1>&6 -echo "configure:5458: checking for ELF" >&5 +echo "configure:5775: checking for ELF" >&5 cat > conftest.$ac_ext <<EOF -#line 5460 "configure" +#line 5777 "configure" #include "confdefs.h" #ifdef __ELF__ @@ -5778,17 +6095,17 @@ EOF # that don't grok the -Bexport option. Test that it does. hold_ldflags=$LDFLAGS echo $ac_n "checking for ld accepts -Bexport flag""... $ac_c" 1>&6 -echo "configure:5782: checking for ld accepts -Bexport flag" >&5 +echo "configure:6099: checking for ld accepts -Bexport flag" >&5 LDFLAGS="${LDFLAGS} -Wl,-Bexport" cat > conftest.$ac_ext <<EOF -#line 5785 "configure" +#line 6102 "configure" #include "confdefs.h" int main() { int i; ; return 0; } EOF -if { (eval echo configure:5792: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then +if { (eval echo configure:6109: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* found=yes else @@ -5834,9 +6151,9 @@ rm -f conftest* if test "x$DL_OBJS" = "xtclLoadAout.o" ; then echo $ac_n "checking sys/exec.h""... $ac_c" 1>&6 -echo "configure:5838: checking sys/exec.h" >&5 +echo "configure:6155: checking sys/exec.h" >&5 cat > conftest.$ac_ext <<EOF -#line 5840 "configure" +#line 6157 "configure" #include "confdefs.h" #include <sys/exec.h> int main() { @@ -5854,7 +6171,7 @@ int main() { ; return 0; } EOF -if { (eval echo configure:5858: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:6175: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_ok=usable else @@ -5872,9 +6189,9 @@ EOF else echo $ac_n "checking a.out.h""... $ac_c" 1>&6 -echo "configure:5876: checking a.out.h" >&5 +echo "configure:6193: checking a.out.h" >&5 cat > conftest.$ac_ext <<EOF -#line 5878 "configure" +#line 6195 "configure" #include "confdefs.h" #include <a.out.h> int main() { @@ -5892,7 +6209,7 @@ int main() { ; return 0; } EOF -if { (eval echo configure:5896: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:6213: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_ok=usable else @@ -5910,9 +6227,9 @@ EOF else echo $ac_n "checking sys/exec_aout.h""... $ac_c" 1>&6 -echo "configure:5914: checking sys/exec_aout.h" >&5 +echo "configure:6231: checking sys/exec_aout.h" >&5 cat > conftest.$ac_ext <<EOF -#line 5916 "configure" +#line 6233 "configure" #include "confdefs.h" #include <sys/exec_aout.h> int main() { @@ -5930,7 +6247,7 @@ int main() { ; return 0; } EOF -if { (eval echo configure:5934: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:6251: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* tcl_ok=usable else @@ -6027,7 +6344,7 @@ fi echo $ac_n "checking for build with symbols""... $ac_c" 1>&6 -echo "configure:6031: checking for build with symbols" >&5 +echo "configure:6348: checking for build with symbols" >&5 # Check whether --enable-symbols or --disable-symbols was given. if test "${enable_symbols+set}" = set; then enableval="$enable_symbols" @@ -6064,17 +6381,17 @@ TCL_DBGX=${DBGX} do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:6068: checking for $ac_hdr" >&5 +echo "configure:6385: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 6073 "configure" +#line 6390 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6078: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6395: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -6104,17 +6421,17 @@ done do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:6108: checking for $ac_hdr" >&5 +echo "configure:6425: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <<EOF -#line 6113 "configure" +#line 6430 "configure" #include "confdefs.h" #include <$ac_hdr> EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6118: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6435: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* @@ -6141,7 +6458,7 @@ fi done echo $ac_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O""... $ac_c" 1>&6 -echo "configure:6145: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 +echo "configure:6462: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 if test -f /usr/lib/NextStep/software_version; then system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version` else @@ -6203,7 +6520,7 @@ TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX} echo $ac_n "checking how to build libraries""... $ac_c" 1>&6 -echo "configure:6207: checking how to build libraries" >&5 +echo "configure:6524: checking how to build libraries" >&5 # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" @@ -6403,6 +6720,8 @@ TCL_SHARED_BUILD=${SHARED_BUILD} + + trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure @@ -6600,6 +6919,7 @@ s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g s%@TCL_SHARED_LIB_SUFFIX@%$TCL_SHARED_LIB_SUFFIX%g s%@TCL_SHLIB_CFLAGS@%$TCL_SHLIB_CFLAGS%g s%@TCL_UNSHARED_LIB_SUFFIX@%$TCL_UNSHARED_LIB_SUFFIX%g +s%@TCL_HAS_LONGLONG@%$TCL_HAS_LONGLONG%g s%@MAKE_LIB@%$MAKE_LIB%g s%@MAKE_STUB_LIB@%$MAKE_STUB_LIB%g s%@BUILD_DLTEST@%$BUILD_DLTEST%g diff --git a/unix/configure.in b/unix/configure.in index 2e4902c..c09e880 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.81 2002/02/05 02:48:40 hobbs Exp $ +# RCS: @(#) $Id: configure.in,v 1.82 2002/02/15 14:28:50 dkf Exp $ AC_INIT(../generic/tcl.h) @@ -65,6 +65,14 @@ fi fi #-------------------------------------------------------------------- +# Detect what compiler flags to set for 64-bit support. +#-------------------------------------------------------------------- + +SC_TCL_EARLY_FLAGS + +SC_TCL_64BIT_FLAGS + +#-------------------------------------------------------------------- # Supply substitutes for missing POSIX library procedures, or # set flags so Tcl uses alternate procedures. #-------------------------------------------------------------------- @@ -76,7 +84,7 @@ AC_CHECK_FUNCS(getcwd, , [AC_DEFINE(USEGETWD)]) AC_REPLACE_FUNCS(opendir strstr) -AC_REPLACE_FUNCS(strtol tmpnam waitpid) +AC_REPLACE_FUNCS(strtol strtoll strtoull tmpnam waitpid) AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR)]) AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD)]) AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3)]) @@ -112,16 +120,23 @@ SC_SERIAL_PORT # special flag. #-------------------------------------------------------------------- -AC_MSG_CHECKING([fd_set and sys/select]) -AC_TRY_COMPILE([#include <sys/types.h>], - [fd_set readMask, writeMask;], tk_ok=yes, tk_ok=no) -if test $tk_ok = no; then - AC_HEADER_EGREP(fd_mask, sys/select.h, tk_ok=yes) - if test $tk_ok = yes; then +AC_MSG_CHECKING([for fd_set in sys/types]) +AC_CACHE_VAL(tcl_cv_type_fd_set, + AC_TRY_COMPILE([#include <sys/types.h>],[fd_set readMask, writeMask;], + tcl_cv_type_fd_set=yes, tcl_cv_type_fd_set=no)) +AC_MSG_RESULT($tcl_cv_type_fd_set) +tk_ok=$tcl_cv_type_fd_set +if test $tcl_cv_type_fd_set = no; then + AC_MSG_CHECKING([for fd_mask in sys/select]) + AC_CACHE_VAL(tcl_cv_grep_fd_mask, + AC_HEADER_EGREP(fd_mask, sys/select.h, + tcl_cv_grep_fd_mask=present, tcl_cv_grep_fd_mask=missing)) + AC_MSG_RESULT($tcl_cv_grep_fd_mask) + if test $tcl_cv_grep_fd_mask = present; then AC_DEFINE(HAVE_SYS_SELECT_H) + tk_ok=yes fi fi -AC_MSG_RESULT($tk_ok) if test $tk_ok = no; then AC_DEFINE(NO_FD_SET) fi @@ -258,14 +273,15 @@ AC_CHECK_FUNC(opendir, , [AC_DEFINE(USE_DIRENT2_H)]) #-------------------------------------------------------------------- AC_MSG_CHECKING([union wait]) -AC_TRY_LINK([#include <sys/types.h> +AC_CACHE_VAL(tcl_cv_union_wait, + AC_TRY_LINK([#include <sys/types.h> #include <sys/wait.h>], [ union wait x; WIFEXITED(x); /* Generates compiler error if WIFEXITED * uses an int. */ -], tcl_ok=yes, tcl_ok=no) -AC_MSG_RESULT($tcl_ok) -if test $tcl_ok = no; then + ], tcl_cv_union_wait=yes, tcl_cv_union_wait=no)) +AC_MSG_RESULT($tcl_cv_union_wait) +if test $tcl_cv_union_wait = no; then AC_DEFINE(NO_UNION_WAIT) fi @@ -275,13 +291,14 @@ fi #-------------------------------------------------------------------- AC_MSG_CHECKING([matherr support]) -AC_TRY_COMPILE([#include <math.h>], [ -struct exception x; -x.type = DOMAIN; -x.type = SING; -], tcl_ok=yes, tcl_ok=no) -AC_MSG_RESULT($tcl_ok) -if test $tcl_ok = yes; then +AC_CACHE_VAL(tcl_cv_func_matherr, + AC_TRY_COMPILE([#include <math.h>], [ + struct exception x; + x.type = DOMAIN; + x.type = SING; + ], tcl_cv_func_matherr=yes, tcl_cv_func_matherr=no)) +AC_MSG_RESULT($tcl_cv_func_matherr) +if test $tcl_cv_func_matherr = yes; then AC_DEFINE(NEED_MATHERR) fi @@ -318,10 +335,13 @@ AC_CHECK_FUNC(BSDgettimeofday, AC_CHECK_FUNC(gettimeofday, , [AC_DEFINE(NO_GETTOD)]) ]) AC_MSG_CHECKING([for gettimeofday declaration]) -AC_EGREP_HEADER(gettimeofday, sys/time.h, AC_MSG_RESULT(present), [ - AC_MSG_RESULT(missing) +AC_CACHE_VAL(tcl_cv_grep_gettimeofday, + AC_EGREP_HEADER(gettimeofday, sys/time.h, + tcl_cv_grep_gettimeofday=present, tcl_cv_grep_gettimeofday=missing)) +AC_MSG_RESULT($tcl_cv_grep_gettimeofday) +if test $tcl_cv_grep_gettimeofday = missing ; then AC_DEFINE(GETTOD_NOT_DECLARED) -]) +fi #-------------------------------------------------------------------- # The following code checks to see whether it is possible to get @@ -331,12 +351,13 @@ AC_EGREP_HEADER(gettimeofday, sys/time.h, AC_MSG_RESULT(present), [ AC_C_CHAR_UNSIGNED AC_MSG_CHECKING([signed char declarations]) -AC_TRY_COMPILE(, [ -signed char *p; -p = 0; -], tcl_ok=yes, tcl_ok=no) -AC_MSG_RESULT($tcl_ok) -if test $tcl_ok = yes; then +AC_CACHE_VAL(tcl_cv_char_signed, + AC_TRY_COMPILE(, [ + signed char *p; + p = 0; + ], tcl_cv_char_signed=yes, tcl_cv_char_signed=no)) +AC_MSG_RESULT($tcl_cv_char_signed) +if test $tcl_cv_char_signed = yes; then AC_DEFINE(HAVE_SIGNED_CHAR) fi @@ -552,6 +573,8 @@ AC_SUBST(TCL_SHARED_LIB_SUFFIX) AC_SUBST(TCL_SHLIB_CFLAGS) AC_SUBST(TCL_UNSHARED_LIB_SUFFIX) +AC_SUBST(TCL_HAS_LONGLONG) + AC_SUBST(MAKE_LIB) AC_SUBST(MAKE_STUB_LIB) AC_SUBST(BUILD_DLTEST) diff --git a/unix/mkLinks b/unix/mkLinks index 1cdd758..8cd932a 100644 --- a/unix/mkLinks +++ b/unix/mkLinks @@ -254,13 +254,17 @@ if test -r CrtObjCmd.3; then rm -f Tcl_DeleteCommand.3 rm -f Tcl_DeleteCommandFromToken.3 rm -f Tcl_GetCommandInfo.3 + rm -f Tcl_GetCommandInfoFromToken.3 rm -f Tcl_SetCommandInfo.3 + rm -f Tcl_SetCommandInfoFromToken.3 rm -f Tcl_GetCommandName.3 ln CrtObjCmd.3 Tcl_CreateObjCommand.3 ln CrtObjCmd.3 Tcl_DeleteCommand.3 ln CrtObjCmd.3 Tcl_DeleteCommandFromToken.3 ln CrtObjCmd.3 Tcl_GetCommandInfo.3 + ln CrtObjCmd.3 Tcl_GetCommandInfoFromToken.3 ln CrtObjCmd.3 Tcl_SetCommandInfo.3 + ln CrtObjCmd.3 Tcl_SetCommandInfoFromToken.3 ln CrtObjCmd.3 Tcl_GetCommandName.3 fi if test -r CrtSlave.3; then @@ -297,8 +301,10 @@ if test -r CrtTimerHdlr.3; then fi if test -r CrtTrace.3; then rm -f Tcl_CreateTrace.3 + rm -f Tcl_CreateObjTrace.3 rm -f Tcl_DeleteTrace.3 ln CrtTrace.3 Tcl_CreateTrace.3 + ln CrtTrace.3 Tcl_CreateObjTrace.3 ln CrtTrace.3 Tcl_DeleteTrace.3 fi if test -r DString.3; then @@ -494,6 +500,7 @@ if test -r FileSystem.3; then rm -f Tcl_FSNewNativePath.3 rm -f Tcl_FSGetNativePath.3 rm -f Tcl_FSFileSystemInfo.3 + rm -f Tcl_AllocStatBuf.3 ln FileSystem.3 Tcl_FSRegister.3 ln FileSystem.3 Tcl_FSUnregister.3 ln FileSystem.3 Tcl_FSData.3 @@ -534,6 +541,7 @@ if test -r FileSystem.3; then ln FileSystem.3 Tcl_FSNewNativePath.3 ln FileSystem.3 Tcl_FSGetNativePath.3 ln FileSystem.3 Tcl_FSFileSystemInfo.3 + ln FileSystem.3 Tcl_AllocStatBuf.3 fi if test -r FindExec.3; then rm -f Tcl_FindExecutable.3 @@ -622,16 +630,22 @@ fi if test -r IntObj.3; then rm -f Tcl_NewIntObj.3 rm -f Tcl_NewLongObj.3 + rm -f Tcl_NewWideIntObj.3 rm -f Tcl_SetIntObj.3 rm -f Tcl_SetLongObj.3 + rm -f Tcl_SetWideIntObj.3 rm -f Tcl_GetIntFromObj.3 rm -f Tcl_GetLongFromObj.3 + rm -f Tcl_GetWideIntFromObj.3 ln IntObj.3 Tcl_NewIntObj.3 ln IntObj.3 Tcl_NewLongObj.3 + ln IntObj.3 Tcl_NewWideIntObj.3 ln IntObj.3 Tcl_SetIntObj.3 ln IntObj.3 Tcl_SetLongObj.3 + ln IntObj.3 Tcl_SetWideIntObj.3 ln IntObj.3 Tcl_GetIntFromObj.3 ln IntObj.3 Tcl_GetLongFromObj.3 + ln IntObj.3 Tcl_GetWideIntFromObj.3 fi if test -r Interp.3; then rm -f Tcl_Interp.3 diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 638c21c..63da87b 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1422,7 +1422,9 @@ dnl AC_CHECK_TOOL(AR, ar, :) # # Determine which interface to use to talk to the serial port. # Note that #include lines must begin in leftmost column for -# some compilers to recognize them as preprocessor directives. +# some compilers to recognize them as preprocessor directives, +# and some build environments have stdin not pointing at a +# pseudo-terminal (usually /dev/null instead.) # # Arguments: # none @@ -1438,12 +1440,11 @@ dnl AC_CHECK_TOOL(AR, ar, :) AC_DEFUN(SC_SERIAL_PORT, [ AC_MSG_CHECKING([termios vs. termio vs. sgtty]) - + AC_CACHE_VAL(tcl_cv_api_serial, [ AC_TRY_RUN([ #include <termios.h> -main() -{ +int main() { struct termios t; if (tcgetattr(0, &t) == 0) { cfsetospeed(&t, 0); @@ -1451,32 +1452,25 @@ main() return 0; } return 1; -}], tk_ok=termios, tk_ok=no, tk_ok=no) - - if test $tk_ok = termios; then - AC_DEFINE(USE_TERMIOS) - else +}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + if test $tcl_cv_api_serial = no ; then AC_TRY_RUN([ #include <termio.h> -main() -{ +int main() { struct termio t; if (ioctl(0, TCGETA, &t) == 0) { t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; return 0; } return 1; - }], tk_ok=termio, tk_ok=no, tk_ok=no) - - if test $tk_ok = termio; then - AC_DEFINE(USE_TERMIO) - else +}], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + fi + if test $tcl_cv_api_serial = no ; then AC_TRY_RUN([ #include <sgtty.h> -main() -{ +int main() { struct sgttyb t; if (ioctl(0, TIOCGETP, &t) == 0) { t.sg_ospeed = 0; @@ -1484,17 +1478,14 @@ main() return 0; } return 1; -}], tk_ok=sgtty, tk_ok=none, tk_ok=none) - - if test $tk_ok = sgtty; then - AC_DEFINE(USE_SGTTY) - else +}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=none, tcl_cv_api_serial=none) + fi + if test $tcl_cv_api_serial = no ; then AC_TRY_RUN([ #include <termios.h> #include <errno.h> -main() -{ +int main() { struct termios t; if (tcgetattr(0, &t) == 0 || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { @@ -1503,17 +1494,14 @@ main() return 0; } return 1; -}], tk_ok=termios, tk_ok=no, tk_ok=no) - - if test $tk_ok = termios; then - AC_DEFINE(USE_TERMIOS) - else +}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + fi + if test $tcl_cv_api_serial = no; then AC_TRY_RUN([ #include <termio.h> #include <errno.h> -main() -{ +int main() { struct termio t; if (ioctl(0, TCGETA, &t) == 0 || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { @@ -1521,17 +1509,14 @@ main() return 0; } return 1; - }], tk_ok=termio, tk_ok=no, tk_ok=no) - - if test $tk_ok = termio; then - AC_DEFINE(USE_TERMIO) - else + }], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + fi + if test $tcl_cv_api_serial = no; then AC_TRY_RUN([ #include <sgtty.h> #include <errno.h> -main() -{ +int main() { struct sgttyb t; if (ioctl(0, TIOCGETP, &t) == 0 || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { @@ -1540,17 +1525,14 @@ main() return 0; } return 1; -}], tk_ok=sgtty, tk_ok=none, tk_ok=none) - - if test $tk_ok = sgtty; then - AC_DEFINE(USE_SGTTY) - fi - fi - fi - fi - fi - fi - AC_MSG_RESULT($tk_ok) +}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=none, tcl_cv_api_serial=none) + fi]) + case $tcl_cv_api_serial in + termios) AC_DEFINE(USE_TERMIOS);; + termio) AC_DEFINE(USE_TERMIO);; + sgtty) AC_DEFINE(USE_SGTTY);; + esac + AC_MSG_RESULT($tcl_cv_api_serial) ]) #-------------------------------------------------------------------- @@ -1824,46 +1806,53 @@ AC_DEFUN(SC_TIME_HANDLER, [ AC_CHECK_FUNCS(gmtime_r localtime_r) AC_MSG_CHECKING([tm_tzadj in struct tm]) - AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;], - [AC_DEFINE(HAVE_TM_TZADJ) - AC_MSG_RESULT(yes)], - AC_MSG_RESULT(no)) + AC_CACHE_VAL(tcl_cv_member_tm_tzadj, + AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;], + tcl_cv_member_tm_tzadj=yes, tcl_cv_member_tm_tzadj=no)) + AC_MSG_RESULT($tcl_cv_member_tm_tzadj) + if test $tcl_cv_member_tm_tzadj = yes ; then + AC_DEFINE(HAVE_TM_TZADJ) + fi AC_MSG_CHECKING([tm_gmtoff in struct tm]) - AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;], - [AC_DEFINE(HAVE_TM_GMTOFF) - AC_MSG_RESULT(yes)], - AC_MSG_RESULT(no)) + AC_CACHE_VAL(tcl_cv_member_tm_gmtoff, + AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;], + tcl_cv_member_tm_gmtoff=yes, tcl_cv_member_tm_gmtoff=no)) + AC_MSG_RESULT($tcl_cv_member_tm_gmtoff) + if test $tcl_cv_member_tm_gmtoff = yes ; then + AC_DEFINE(HAVE_TM_GMTOFF) + fi # # Its important to include time.h in this check, as some systems # (like convex) have timezone functions, etc. # - have_timezone=no AC_MSG_CHECKING([long timezone variable]) - AC_TRY_COMPILE([#include <time.h>], + AC_CACHE_VAL(tcl_cv_var_timezone, + AC_TRY_COMPILE([#include <time.h>], [extern long timezone; timezone += 1; exit (0);], - [have_timezone=yes + tcl_cv_timezone_long=yes, tcl_cv_timezone_long=no)) + AC_MSG_RESULT($tcl_cv_timezone_long) + if test $tcl_cv_timezone_long = yes ; then + AC_DEFINE(HAVE_TIMEZONE_VAR) + else + # + # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. + # + AC_MSG_CHECKING([time_t timezone variable]) + AC_CACHE_VAL(tcl_cv_timezone_time, + AC_TRY_COMPILE([#include <time.h>], + [extern time_t timezone; + timezone += 1; + exit (0);], + tcl_cv_timezone_time=yes, tcl_cv_timezone_time=no)) + AC_MSG_RESULT($tcl_cv_timezone_time) + if test $tcl_cv_timezone_time = yes ; then AC_DEFINE(HAVE_TIMEZONE_VAR) - AC_MSG_RESULT(yes)], - AC_MSG_RESULT(no)) - - # - # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. - # - if test "$have_timezone" = no; then - AC_MSG_CHECKING([time_t timezone variable]) - AC_TRY_COMPILE([#include <time.h>], - [extern time_t timezone; - timezone += 1; - exit (0);], - [AC_DEFINE(HAVE_TIMEZONE_VAR) - AC_MSG_RESULT(yes)], - AC_MSG_RESULT(no)) + fi fi - ]) #-------------------------------------------------------------------- @@ -2002,3 +1991,110 @@ AC_DEFUN(SC_TCL_LINK_LIBS, [ AC_SUBST(TCL_LIBS) AC_SUBST(MATH_LIBS) ]) + +#-------------------------------------------------------------------- +# SC_TCL_EARLY_FLAGS +# +# Check for what flags are needed to be passed so the correct OS +# features are available. +# +# Arguments: +# None +# +# Results: +# +# Might define the following vars: +# _ISOC99_SOURCE +# _LARGEFILE64_SOURCE +# +#-------------------------------------------------------------------- + +AC_DEFUN(SC_TCL_EARLY_FLAG,[ + AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]), + AC_TRY_COMPILE([$2], $3, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no, + AC_TRY_COMPILE([[#define ]$1[ 1 +]$2], $3, + [tcl_cv_flag_]translit($1,[A-Z],[a-z])=yes, + [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no))) + if test ["x${tcl_cv_flag_]translit($1,[A-Z],[a-z])[}" = "xyes"] ; then + AC_DEFINE($1) + tcl_flags="$tcl_flags $1" + fi]) + +AC_DEFUN(SC_TCL_EARLY_FLAGS,[ + AC_MSG_CHECKING([for required early compiler flags]) + tcl_flags="" + SC_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include <stdlib.h>], + [char *p = (char *)strtoll; char *q = (char *)strtoull;]) + SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include <sys/stat.h>], + [struct stat64 buf; int i = stat64("/", &buf);]) + if test "x${tcl_flags}" = "x" ; then + AC_MSG_RESULT(none) + else + AC_MSG_RESULT(${tcl_flags}) + fi]) + +#-------------------------------------------------------------------- +# SC_TCL_64BIT_FLAGS +# +# Check for what is defined in the way of 64-bit features. +# +# Arguments: +# None +# +# Results: +# +# Might define the following vars: +# TCL_WIDE_INT_IS_LONG +# TCL_WIDE_INT_TYPE +# HAVE_STRUCT_DIRENT64 +# HAVE_STRUCT_STAT64 +# HAVE_TYPE_OFF64_T +# +#-------------------------------------------------------------------- + +AC_DEFUN(SC_TCL_64BIT_FLAGS, [ + AC_MSG_CHECKING([for 64-bit integer type]) + AC_CACHE_VAL(tcl_cv_type_64bit,[ + AC_TRY_COMPILE(,[__int64 value = (__int64) 0;], + tcl_cv_type_64bit=__int64,tcl_cv_type_64bit=none + AC_TRY_RUN([#include <unistd.h> + int main() {exit(!(sizeof(long long) > sizeof(long)));} + ], tcl_cv_type_64bit="long long"))]) + if test "${tcl_cv_type_64bit}" = none ; then + AC_MSG_RESULT(using long) + else + AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit}) + AC_MSG_RESULT(${tcl_cv_type_64bit}) + + # Now check for auxiliary declarations + AC_MSG_CHECKING([for struct dirent64]) + AC_CACHE_VAL(tcl_cv_struct_dirent64,[ + AC_TRY_COMPILE([#include <sys/types.h> +#include <sys/dirent.h>],[struct dirent64 p;], + tcl_cv_struct_dirent64=yes,tcl_cv_struct_dirent64=no)]) + if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then + AC_DEFINE(HAVE_STRUCT_DIRENT64) + fi + AC_MSG_RESULT(${tcl_cv_struct_dirent64}) + + AC_MSG_CHECKING([for struct stat64]) + AC_CACHE_VAL(tcl_cv_struct_stat64,[ + AC_TRY_COMPILE([#include <sys/stat.h>],[struct stat64 p; +], + tcl_cv_struct_stat64=yes,tcl_cv_struct_stat64=no)]) + if test "x${tcl_cv_struct_stat64}" = "xyes" ; then + AC_DEFINE(HAVE_STRUCT_STAT64) + fi + AC_MSG_RESULT(${tcl_cv_struct_stat64}) + + AC_MSG_CHECKING([for off64_t]) + AC_CACHE_VAL(tcl_cv_type_off64_t,[ + AC_TRY_COMPILE([#include <sys/types.h>],[off64_t offset; +], + tcl_cv_type_off64_t=yes,tcl_cv_type_off64_t=no)]) + if test "x${tcl_cv_type_off64_t}" = "xyes" ; then + AC_DEFINE(HAVE_TYPE_OFF64_T) + fi + AC_MSG_RESULT(${tcl_cv_type_off64_t}) + fi]) diff --git a/unix/tclLoadAout.c b/unix/tclLoadAout.c index b9ad4b9..afd956c 100644 --- a/unix/tclLoadAout.c +++ b/unix/tclLoadAout.c @@ -14,7 +14,7 @@ * and Design Engineering (MADE) Initiative through ARPA contract * F33615-94-C-4400. * - * RCS: @(#) $Id: tclLoadAout.c,v 1.9 2002/01/09 19:09:28 kennykb Exp $ + * RCS: @(#) $Id: tclLoadAout.c,v 1.10 2002/02/15 14:28:50 dkf Exp $ */ #include "tclInt.h" @@ -268,7 +268,14 @@ TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, (void) brk (startAddress + relocatedSize); - /* Seek to the start of the module's text */ + /* + * Seek to the start of the module's text. + * + * Note that this does not really work with large files (i.e. where + * lseek64 exists and is different to lseek), but anyone trying to + * dynamically load a binary that is larger than what can fit in + * addressable memory is in trouble anyway... + */ #if defined(__mips) || defined(mips) status = lseek (relocatedFd, diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index aa11fcf..19cbbba 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixChan.c,v 1.28 2002/02/04 23:51:59 andreas_kupries Exp $ + * RCS: @(#) $Id: tclUnixChan.c,v 1.29 2002/02/15 14:28:50 dkf Exp $ */ #include "tclInt.h" /* Internal definitions for Tcl. */ @@ -191,8 +191,8 @@ static int FileInputProc _ANSI_ARGS_((ClientData instanceData, static int FileOutputProc _ANSI_ARGS_(( ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)); -static int FileSeekProc _ANSI_ARGS_((ClientData instanceData, - long offset, int mode, int *errorCode)); +static Tcl_WideInt FileSeekProc _ANSI_ARGS_((ClientData instanceData, + Tcl_WideInt offset, int mode, int *errorCode)); static void FileWatchProc _ANSI_ARGS_((ClientData instanceData, int mask)); static void TcpAccept _ANSI_ARGS_((ClientData data, int mask)); @@ -522,10 +522,10 @@ FileCloseProc(instanceData, interp) *---------------------------------------------------------------------- */ -static int +static Tcl_WideInt FileSeekProc(instanceData, offset, mode, errorCodePtr) ClientData instanceData; /* File state. */ - long offset; /* Offset to seek to. */ + Tcl_WideInt offset; /* Offset to seek to. */ int mode; /* Relative to where * should we seek? Can be * one of SEEK_START, @@ -533,9 +533,9 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr) int *errorCodePtr; /* To store error code. */ { FileState *fsPtr = (FileState *) instanceData; - int newLoc; + Tcl_WideInt newLoc; - newLoc = lseek(fsPtr->fd, (off_t) offset, mode); + newLoc = Tcl_PlatformSeek(fsPtr->fd, (Tcl_SeekOffset) offset, mode); *errorCodePtr = (newLoc == -1) ? errno : 0; return newLoc; @@ -1350,7 +1350,7 @@ TclpOpenFileChannel(interp, pathPtr, modeString, permissions) if (native == NULL) { return NULL; } - fd = open(native, mode, permissions); + fd = Tcl_PlatformOpen(native, mode, permissions); if (fd < 0) { if (interp != (Tcl_Interp *) NULL) { @@ -1402,7 +1402,8 @@ TclpOpenFileChannel(interp, pathPtr, modeString, permissions) (ClientData) fsPtr, channelPermissions); if (seekFlag) { - if (Tcl_Seek(fsPtr->channel, 0, SEEK_END) < 0) { + if (Tcl_Seek(fsPtr->channel, (Tcl_WideInt)0, + SEEK_END) < (Tcl_WideInt)0) { if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "couldn't seek to end of file on \"", channelName, "\": ", Tcl_PosixError(interp), NULL); @@ -2521,8 +2522,8 @@ TclpGetDefaultStdChannel(type) switch (type) { case TCL_STDIN: - if ((lseek(0, (off_t) 0, SEEK_CUR) == -1) && - (errno == EBADF)) { + if ((Tcl_PlatformSeek(0, (Tcl_SeekOffset) 0, + SEEK_CUR) == (Tcl_SeekOffset)-1) && (errno == EBADF)) { return (Tcl_Channel) NULL; } fd = 0; @@ -2530,8 +2531,8 @@ TclpGetDefaultStdChannel(type) bufMode = "line"; break; case TCL_STDOUT: - if ((lseek(1, (off_t) 0, SEEK_CUR) == -1) && - (errno == EBADF)) { + if ((Tcl_PlatformSeek(1, (Tcl_SeekOffset) 0, + SEEK_CUR) == (Tcl_SeekOffset)-1) && (errno == EBADF)) { return (Tcl_Channel) NULL; } fd = 1; @@ -2539,8 +2540,8 @@ TclpGetDefaultStdChannel(type) bufMode = "line"; break; case TCL_STDERR: - if ((lseek(2, (off_t) 0, SEEK_CUR) == -1) && - (errno == EBADF)) { + if ((Tcl_PlatformSeek(2, (Tcl_SeekOffset) 0, + SEEK_CUR) == (Tcl_SeekOffset)-1) && (errno == EBADF)) { return (Tcl_Channel) NULL; } fd = 2; diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 768798e..80383d8 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFCmd.c,v 1.16 2002/02/12 14:24:27 davygrvy Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.17 2002/02/15 14:28:50 dkf Exp $ * * Portions of this code were derived from NetBSD source code which has * the following copyright notice: @@ -97,7 +97,7 @@ static int GetModeFromPermString _ANSI_ARGS_(( */ typedef int (TraversalProc) _ANSI_ARGS_((Tcl_DString *srcPtr, - Tcl_DString *dstPtr, CONST struct stat *statBufPtr, int type, + Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr)); /* @@ -128,9 +128,9 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = { */ static int CopyFile _ANSI_ARGS_((CONST char *src, - CONST char *dst, CONST struct stat *statBufPtr)); + CONST char *dst, CONST Tcl_StatBuf *statBufPtr)); static int CopyFileAtts _ANSI_ARGS_((CONST char *src, - CONST char *dst, CONST struct stat *statBufPtr)); + CONST char *dst, CONST Tcl_StatBuf *statBufPtr)); static int DoCopyFile _ANSI_ARGS_((CONST char *srcPtr, CONST char *dstPtr)); static int DoCreateDirectory _ANSI_ARGS_((CONST char *pathPtr)); @@ -140,10 +140,10 @@ static int DoRemoveDirectory _ANSI_ARGS_((Tcl_DString *pathPtr, static int DoRenameFile _ANSI_ARGS_((CONST char *src, CONST char *dst)); static int TraversalCopy _ANSI_ARGS_((Tcl_DString *srcPtr, - Tcl_DString *dstPtr, CONST struct stat *statBufPtr, + Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr)); static int TraversalDelete _ANSI_ARGS_((Tcl_DString *srcPtr, - Tcl_DString *dstPtr, CONST struct stat *statBufPtr, + Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr)); static int TraverseUnixTree _ANSI_ARGS_(( TraversalProc *traversalProc, @@ -230,7 +230,7 @@ DoRenameFile(src, dst) if (errno == EINVAL) { char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN]; DIR *dirPtr; - struct dirent *dirEntPtr; + Tcl_DirEntry *dirEntPtr; if ((realpath((char *) src, srcPath) != NULL) /* INTL: Native. */ && (realpath((char *) dst, dstPath) != NULL) /* INTL: Native. */ @@ -238,7 +238,7 @@ DoRenameFile(src, dst) dirPtr = opendir(dst); /* INTL: Native. */ if (dirPtr != NULL) { while (1) { - dirEntPtr = readdir(dirPtr); /* INTL: Native. */ + dirEntPtr = Tcl_PlatformReaddir(dirPtr); /* INTL: Native. */ if (dirEntPtr == NULL) { break; } @@ -317,13 +317,13 @@ DoCopyFile(src, dst) CONST char *src; /* Pathname of file to be copied (native). */ CONST char *dst; /* Pathname of file to copy to (native). */ { - struct stat srcStatBuf, dstStatBuf; + Tcl_StatBuf srcStatBuf, dstStatBuf; /* * Have to do a stat() to determine the filetype. */ - if (lstat(src, &srcStatBuf) != 0) { /* INTL: Native. */ + if (Tcl_PlatformLStat(src, &srcStatBuf) != 0) { /* INTL: Native. */ return TCL_ERROR; } if (S_ISDIR(srcStatBuf.st_mode)) { @@ -336,7 +336,7 @@ DoCopyFile(src, dst) * exists, so we remove it first */ - if (lstat(dst, &dstStatBuf) == 0) { /* INTL: Native. */ + if (Tcl_PlatformLStat(dst, &dstStatBuf) == 0) { /* INTL: Native. */ if (S_ISDIR(dstStatBuf.st_mode)) { errno = EISDIR; return TCL_ERROR; @@ -408,7 +408,7 @@ CopyFile(src, dst, statBufPtr) CONST char *src; /* Pathname of file to copy (native). */ CONST char *dst; /* Pathname of file to create/overwrite * (native). */ - CONST struct stat *statBufPtr; + CONST Tcl_StatBuf *statBufPtr; /* Used to determine mode and blocksize. */ { int srcFd; @@ -417,12 +417,12 @@ CopyFile(src, dst, statBufPtr) char *buffer; /* Data buffer for copy */ size_t nread; - if ((srcFd = open(src, O_RDONLY, 0)) < 0) { /* INTL: Native. */ + if ((srcFd = Tcl_PlatformOpen(src, O_RDONLY, 0)) < 0) { /* INTL: Native. */ return TCL_ERROR; } - dstFd = open(dst, O_CREAT | O_TRUNC | O_WRONLY, /* INTL: Native. */ - statBufPtr->st_mode); + dstFd = Tcl_PlatformOpen(dst, /* INTL: Native. */ + O_CREAT | O_TRUNC | O_WRONLY, statBufPtr->st_mode); if (dstFd < 0) { close(srcFd); return TCL_ERROR; @@ -694,10 +694,10 @@ DoRemoveDirectory(pathPtr, recursive, errorPtr) if (recursive != 0) { /* We should try to change permissions so this can be deleted */ - struct stat statBuf; + Tcl_StatBuf statBuf; int newPerm; - if (stat(path, &statBuf) == 0) { + if (Tcl_PlatformStat(path, &statBuf) == 0) { oldPerm = (mode_t) (statBuf.st_mode & 0x00007FFF); } @@ -770,11 +770,11 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr) * DString filled with UTF-8 name of file * causing error. */ { - struct stat statBuf; + Tcl_StatBuf statBuf; CONST char *source, *errfile; int result, sourceLen; int targetLen; - struct dirent *dirEntPtr; + Tcl_DirEntry *dirEntPtr; DIR *dirPtr; errfile = NULL; @@ -782,7 +782,7 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr) targetLen = 0; /* lint. */ source = Tcl_DStringValue(sourcePtr); - if (lstat(source, &statBuf) != 0) { /* INTL: Native. */ + if (Tcl_PlatformLStat(source, &statBuf) != 0) { /* INTL: Native. */ errfile = source; goto end; } @@ -818,7 +818,7 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr) targetLen = Tcl_DStringLength(targetPtr); } - while ((dirEntPtr = readdir(dirPtr)) != NULL) { /* INTL: Native. */ + while ((dirEntPtr = Tcl_PlatformReaddir(dirPtr)) != NULL) { /* INTL: Native. */ if ((strcmp(dirEntPtr->d_name, ".") == 0) || (strcmp(dirEntPtr->d_name, "..") == 0)) { continue; @@ -900,7 +900,7 @@ static int TraversalCopy(srcPtr, dstPtr, statBufPtr, type, errorPtr) Tcl_DString *srcPtr; /* Source pathname to copy (native). */ Tcl_DString *dstPtr; /* Destination pathname of copy (native). */ - CONST struct stat *statBufPtr; + CONST Tcl_StatBuf *statBufPtr; /* Stat info for file specified by srcPtr. */ int type; /* Reason for call - see TraverseUnixTree(). */ Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free @@ -965,7 +965,7 @@ static int TraversalDelete(srcPtr, ignore, statBufPtr, type, errorPtr) Tcl_DString *srcPtr; /* Source pathname (native). */ Tcl_DString *ignore; /* Destination pathname (not used). */ - CONST struct stat *statBufPtr; + CONST Tcl_StatBuf *statBufPtr; /* Stat info for file specified by srcPtr. */ int type; /* Reason for call - see TraverseUnixTree(). */ Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free @@ -1019,7 +1019,7 @@ static int CopyFileAtts(src, dst, statBufPtr) CONST char *src; /* Path name of source file (native). */ CONST char *dst; /* Path name of target file (native). */ - CONST struct stat *statBufPtr; + CONST Tcl_StatBuf *statBufPtr; /* Stat info for source file */ { struct utimbuf tval; @@ -1078,7 +1078,7 @@ GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr) Tcl_Obj *fileName; /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ { - struct stat statBuf; + Tcl_StatBuf statBuf; struct group *groupPtr; int result; @@ -1130,7 +1130,7 @@ GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr) Tcl_Obj *fileName; /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ { - struct stat statBuf; + Tcl_StatBuf statBuf; struct passwd *pwPtr; int result; @@ -1182,7 +1182,7 @@ GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr) Tcl_Obj *fileName; /* The name of the file (UTF-8). */ Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ { - struct stat statBuf; + Tcl_StatBuf statBuf; char returnString[7]; int result; @@ -1360,7 +1360,7 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) { newMode = (mode_t) (mode & 0x00007FFF); } else { - struct stat buf; + Tcl_StatBuf buf; char *modeStringPtr = Tcl_GetString(attributePtr); /* diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 2c1fb87..99a0731 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFile.c,v 1.17 2002/02/12 14:26:05 davygrvy Exp $ + * RCS: @(#) $Id: tclUnixFile.c,v 1.18 2002/02/15 14:28:50 dkf Exp $ */ #include "tclInt.h" @@ -46,8 +46,7 @@ TclpFindExecutable(argv0) * (native). */ { CONST char *name, *p; - - struct stat statBuf; + Tcl_StatBuf statBuf; int length; Tcl_DString buffer, nameString; @@ -117,8 +116,8 @@ TclpFindExecutable(argv0) * strings directly. */ - if ((access(name, X_OK) == 0) /* INTL: Native. */ - && (stat(name, &statBuf) == 0) /* INTL: Native. */ + if ((access(name, X_OK) == 0) /* INTL: Native. */ + && (Tcl_PlatformStat(name, &statBuf) == 0) /* INTL: Native. */ && S_ISREG(statBuf.st_mode)) { goto gotName; } @@ -209,7 +208,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) CONST char *native, *fname, *dirName; DIR *d; Tcl_DString ds; - struct stat statBuf; + Tcl_StatBuf statBuf; int matchHidden; int nativeDirLen; int result = TCL_OK; @@ -261,7 +260,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds); - if ((stat(native, &statBuf) != 0) /* INTL: UTF-8. */ + if ((Tcl_PlatformStat(native, &statBuf) != 0) /* INTL: UTF-8. */ || !S_ISDIR(statBuf.st_mode)) { Tcl_DStringFree(&dsOrig); Tcl_DStringFree(&ds); @@ -299,9 +298,9 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) while (1) { Tcl_DString utfDs; CONST char *utf; - struct dirent *entryPtr; + Tcl_DirEntry *entryPtr; - entryPtr = readdir(d); /* INTL: Native. */ + entryPtr = Tcl_PlatformReaddir(d); /* INTL: Native. */ if (entryPtr == NULL) { break; } @@ -334,7 +333,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) Tcl_DStringAppend(&dsOrig, utf, -1); fname = Tcl_DStringValue(&dsOrig); if (types != NULL) { - struct stat buf; + Tcl_StatBuf buf; char *nativeEntry; Tcl_DStringSetLength(&ds, nativeDirLen); nativeEntry = Tcl_DStringAppend(&ds, entryPtr->d_name, -1); @@ -344,7 +343,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) */ if (types->perm != 0) { - if (stat(nativeEntry, &buf) != 0) { + if (Tcl_PlatformStat(nativeEntry, &buf) != 0) { /* * Either the file has disappeared between the * 'readdir' call and the 'stat' call, or @@ -379,7 +378,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) if (typeOk && (types->type != 0)) { if (types->perm == 0) { /* We haven't yet done a stat on the file */ - if (stat(nativeEntry, &buf) != 0) { + if (Tcl_PlatformStat(nativeEntry, &buf) != 0) { /* Posix error occurred */ typeOk = 0; } @@ -408,12 +407,10 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } else { typeOk = 0; #ifdef S_ISLNK - if (types->type & TCL_GLOB_TYPE_LINK) { - if (lstat(nativeEntry, &buf) == 0) { - if (S_ISLNK(buf.st_mode)) { - typeOk = 1; - } - } + if ((types->type & TCL_GLOB_TYPE_LINK) + && Tcl_PlatformLStat(nativeEntry, &buf)==0 + && S_ISLNK(buf.st_mode)) { + typeOk = 1; } #endif } @@ -554,13 +551,13 @@ TclpObjChdir(pathPtr) int TclpObjLstat(pathPtr, bufPtr) Tcl_Obj *pathPtr; /* Path of file to stat */ - struct stat *bufPtr; /* Filled with results of stat call. */ + Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */ { CONST char *path = Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } else { - return lstat(path, bufPtr); + return Tcl_PlatformLStat(path, bufPtr); } } @@ -690,13 +687,13 @@ TclpReadlink(path, linkPtr) int TclpObjStat(pathPtr, bufPtr) Tcl_Obj *pathPtr; /* Path of file to stat */ - struct stat *bufPtr; /* Filled with results of stat call. */ + Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */ { CONST char *path = Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } else { - return stat(path, bufPtr); + return Tcl_PlatformStat(path, bufPtr); } } @@ -740,6 +737,3 @@ TclpObjLink(pathPtr, toPtr) } #endif - - - diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index a7facd6..f3f67f5 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixPipe.c,v 1.20 2002/02/08 02:52:54 dgp Exp $ + * RCS: @(#) $Id: tclUnixPipe.c,v 1.21 2002/02/15 14:28:50 dkf Exp $ */ #include "tclInt.h" @@ -140,7 +140,7 @@ TclpOpenFile(fname, mode) Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, fname, -1, &ds); - fd = open(native, mode, 0666); /* INTL: Native. */ + fd = Tcl_PlatformOpen(native, mode, 0666); /* INTL: Native. */ Tcl_DStringFree(&ds); if (fd != -1) { fcntl(fd, F_SETFD, FD_CLOEXEC); @@ -151,7 +151,7 @@ TclpOpenFile(fname, mode) */ if (mode & O_WRONLY) { - lseek(fd, (off_t) 0, SEEK_END); + Tcl_PlatformSeek(fd, (Tcl_SeekOffset) 0, SEEK_END); } /* @@ -215,7 +215,7 @@ TclpCreateTempFile(contents) return NULL; } Tcl_DStringFree(&dstring); - lseek(fd, (off_t) 0, SEEK_SET); + Tcl_PlatformSeek(fd, (Tcl_SeekOffset) 0, SEEK_SET); } return MakeFile(fd); } diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index f37d272..5b3b160 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -19,7 +19,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixPort.h,v 1.20 2002/02/12 14:39:48 davygrvy Exp $ + * RCS: @(#) $Id: tclUnixPort.h,v 1.21 2002/02/15 14:28:50 dkf Exp $ */ #ifndef _TCLUNIXPORT @@ -56,6 +56,35 @@ # include <dirent.h> #endif #endif + +#ifdef HAVE_STRUCT_DIRENT64 +typedef struct dirent64 Tcl_DirEntry; +# define Tcl_PlatformReaddir readdir64 +# define Tcl_PlatformReaddir_r readdir64_r +#else +typedef struct dirent Tcl_DirEntry; +# define Tcl_PlatformReaddir readdir +# define Tcl_PlatformReaddir_r readdir_r +#endif + +#ifdef HAVE_TYPE_OFF64_T +typedef off64_t Tcl_SeekOffset; +# define Tcl_PlatformSeek lseek64 +# define Tcl_PlatformOpen open64 +#else +typedef off_t Tcl_SeekOffset; +# define Tcl_PlatformSeek lseek +# define Tcl_PlatformOpen open +#endif + +#ifdef HAVE_STRUCT_STAT64 +# define Tcl_PlatformStat stat64 +# define Tcl_PlatformLStat lstat64 +#else +# define Tcl_PlatformStat stat +# define Tcl_PlatformLStat lstat +#endif + #include <sys/file.h> #ifdef HAVE_SYS_SELECT_H # include <sys/select.h> @@ -501,7 +530,7 @@ typedef pthread_mutex_t TclpMutex; EXTERN void TclpMutexInit _ANSI_ARGS_((TclpMutex *mPtr)); EXTERN void TclpMutexLock _ANSI_ARGS_((TclpMutex *mPtr)); EXTERN void TclpMutexUnlock _ANSI_ARGS_((TclpMutex *mPtr)); -EXTERN struct dirent * TclpReaddir(DIR *); +EXTERN Tcl_DirEntry * TclpReaddir(DIR *); EXTERN struct tm * TclpLocaltime(time_t *); EXTERN struct tm * TclpGmtime(time_t *); EXTERN char * TclpInetNtoa(struct in_addr); @@ -509,6 +538,8 @@ EXTERN char * TclpInetNtoa(struct in_addr); #define localtime(x) TclpLocaltime(x) #define gmtime(x) TclpGmtime(x) #define inet_ntoa(x) TclpInetNtoa(x) +#undef Tcl_PlatformReaddir +#define Tcl_PlatformReaddir(x) TclpReaddir(x) #else typedef int TclpMutex; #define TclpMutexInit(a) diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 5086b2d..82b4d24 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -24,7 +24,7 @@ typedef struct ThreadSpecificData { struct tm gtbuf; struct tm ltbuf; struct { - struct dirent ent; + Tcl_DirEntry ent; char name[PATH_MAX+1]; } rdbuf; } ThreadSpecificData; @@ -790,14 +790,14 @@ TclpFinalizeCondition(condPtr) *---------------------------------------------------------------------- */ -struct dirent * +Tcl_DirEntry * TclpReaddir(DIR * dir) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - struct dirent *ent; + Tcl_DirEntry *ent; ent = &tsdPtr->rdbuf.ent; - if (readdir_r(dir, ent, &ent) != 0) { + if (Tcl_PlatformReaddir_r(dir, ent, &ent) != 0) { ent = NULL; } return ent; diff --git a/win/Makefile.in b/win/Makefile.in index 80dcb28..7e1eead 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.58 2001/11/25 05:22:19 mdejong Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.59 2002/02/15 14:28:51 dkf Exp $ VERSION = @TCL_VERSION@ @@ -282,7 +282,7 @@ WIN_OBJS = \ tclWinTime.$(OBJEXT) COMPAT_OBJS = \ - strftime.$(OBJEXT) + strftime.$(OBJEXT) strtoll.$(OBJEXT) strtoull.$(OBJEXT) PIPE_OBJS = stub16.$(OBJEXT) diff --git a/win/makefile.bc b/win/makefile.bc index 8406a6e..ff1093b 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -175,6 +175,8 @@ TCLOBJS = \ $(TMPDIR)\regfree.obj \ $(TMPDIR)\regerror.obj \ $(TMPDIR)\strftime.obj \ + $(TMPDIR)\strtoll.obj \ + $(TMPDIR)\strtoull.obj \ $(TMPDIR)\tclAlloc.obj \ $(TMPDIR)\tclAsync.obj \ $(TMPDIR)\tclBasic.obj \ diff --git a/win/makefile.vc b/win/makefile.vc index f990c1a..430671d 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -12,7 +12,7 @@ # Copyright (c) 2001 Tomasoft Engineering. # #------------------------------------------------------------------------------ -# RCS: @(#) $Id: makefile.vc,v 1.77 2002/01/11 20:07:23 davygrvy Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.78 2002/02/15 14:28:51 dkf Exp $ #------------------------------------------------------------------------------ !if "$(MSVCDIR)" == "" @@ -218,6 +218,8 @@ TCLOBJS = \ $(TMP_DIR)\regfree.obj \ $(TMP_DIR)\regerror.obj \ $(TMP_DIR)\strftime.obj \ + $(TMP_DIR)\strtoll.obj \ + $(TMP_DIR)\strtoul.obj $(TMP_DIR)\tclAlloc.obj \ $(TMP_DIR)\tclAsync.obj \ $(TMP_DIR)\tclBasic.obj \ diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 04830d9..52084a6 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinChan.c,v 1.19 2002/01/18 14:17:06 dgp Exp $ + * RCS: @(#) $Id: tclWinChan.c,v 1.20 2002/02/15 14:28:51 dkf Exp $ */ #include "tclWinInt.h" @@ -89,8 +89,8 @@ static int FileInputProc _ANSI_ARGS_((ClientData instanceData, char *buf, int toRead, int *errorCode)); static int FileOutputProc _ANSI_ARGS_((ClientData instanceData, CONST char *buf, int toWrite, int *errorCode)); -static int FileSeekProc _ANSI_ARGS_((ClientData instanceData, - long offset, int mode, int *errorCode)); +static Tcl_WideInt FileSeekProc _ANSI_ARGS_((ClientData instanceData, + Tcl_WideInt offset, int mode, int *errorCode)); static void FileSetupProc _ANSI_ARGS_((ClientData clientData, int flags)); static void FileWatchProc _ANSI_ARGS_((ClientData instanceData, @@ -431,17 +431,16 @@ FileCloseProc(instanceData, interp) *---------------------------------------------------------------------- */ -static int +static Tcl_WideInt FileSeekProc(instanceData, offset, mode, errorCodePtr) - ClientData instanceData; /* File state. */ - long offset; /* Offset to seek to. */ - int mode; /* Relative to where - * should we seek? */ - int *errorCodePtr; /* To store error code. */ + ClientData instanceData; /* File state. */ + Tcl_WideInt offset; /* Offset to seek to. */ + int mode; /* Relative to where should we seek? */ + int *errorCodePtr; /* To store error code. */ { FileInfo *infoPtr = (FileInfo *) instanceData; DWORD moveMethod; - DWORD newPos; + DWORD newPos, newPosHigh; *errorCodePtr = 0; if (mode == SEEK_SET) { @@ -452,13 +451,18 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr) moveMethod = FILE_END; } - newPos = SetFilePointer(infoPtr->handle, offset, NULL, moveMethod); - if (newPos == 0xFFFFFFFF) { - TclWinConvertError(GetLastError()); - *errorCodePtr = errno; - return -1; + newPosHigh = (DWORD)(offset >> 32); + newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh, + moveMethod); + if (newPos == INVALID_SET_FILE_POINTER) { + int winError = GetLastError(); + if (winError != NO_ERROR) { + TclWinConvertError(winError); + *errorCodePtr = errno; + return -1; + } } - return newPos; + return ((Tcl_WideInt) newPos) | (((Tcl_WideInt) newPosHigh) << 32); } /* diff --git a/win/tclWinFile.c b/win/tclWinFile.c index ae2776d..90feb0c 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.25 2002/02/08 02:52:55 dgp Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.26 2002/02/15 14:28:51 dkf Exp $ */ #include "tclWinInt.h" @@ -31,7 +31,7 @@ typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); static int NativeAccess(CONST TCHAR *path, int mode); -static int NativeStat(CONST TCHAR *path, struct stat *statPtr); +static int NativeStat(CONST TCHAR *path, Tcl_StatBuf *statPtr); static int NativeIsExec(CONST TCHAR *path); @@ -367,7 +367,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } } if (typeOk && types->type != 0) { - struct stat buf; + Tcl_StatBuf buf; if (NativeStat(nativeName, &buf) != 0) { /* @@ -830,7 +830,7 @@ TclpGetCwd(interp, bufferPtr) int TclpObjStat(pathPtr, statPtr) Tcl_Obj *pathPtr; /* Path of file to stat */ - struct stat *statPtr; /* Filled with results of stat call. */ + Tcl_StatBuf *statPtr; /* Filled with results of stat call. */ { #ifdef OLD_API Tcl_Obj *transPtr; @@ -883,7 +883,7 @@ TclpObjStat(pathPtr, statPtr) static int NativeStat(nativePath, statPtr) CONST TCHAR *nativePath; /* Path of file to stat */ - struct stat *statPtr; /* Filled with results of stat call. */ + Tcl_StatBuf *statPtr; /* Filled with results of stat call. */ { Tcl_DString ds; DWORD attr; @@ -971,10 +971,11 @@ NativeStat(nativePath, statPtr) attr = data.a.dwFileAttributes; - statPtr->st_size = data.a.nFileSizeLow; - statPtr->st_atime = ToCTime(data.a.ftLastAccessTime); - statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime); - statPtr->st_ctime = ToCTime(data.a.ftCreationTime); + statPtr->st_size = ((Tcl_WideInt)data.a.nFileSizeLow) | + (((Tcl_WideInt)data.a.nFileSizeHigh) << 32); + statPtr->st_atime = ToCTime(data.a.ftLastAccessTime); + statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime); + statPtr->st_ctime = ToCTime(data.a.ftCreationTime); } else { WIN32_FILE_ATTRIBUTE_DATA data; if((*tclWinProcs->getFileAttributesExProc)(nativePath, @@ -1031,10 +1032,11 @@ NativeStat(nativePath, statPtr) attr = data.dwFileAttributes; - statPtr->st_size = data.nFileSizeLow; - statPtr->st_atime = ToCTime(data.ftLastAccessTime); - statPtr->st_mtime = ToCTime(data.ftLastWriteTime); - statPtr->st_ctime = ToCTime(data.ftCreationTime); + statPtr->st_size = ((Tcl_WideInt)data.nFileSizeLow) | + (((Tcl_WideInt)data.nFileSizeHigh) << 32); + statPtr->st_atime = ToCTime(data.ftLastAccessTime); + statPtr->st_mtime = ToCTime(data.ftLastWriteTime); + statPtr->st_ctime = ToCTime(data.ftCreationTime); } mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG; @@ -1217,7 +1219,7 @@ TclpObjAccess(pathPtr, mode) int TclpObjLstat(pathPtr, buf) Tcl_Obj *pathPtr; - struct stat *buf; + Tcl_StatBuf *buf; { return TclpObjStat(pathPtr,buf); } diff --git a/win/tclWinMtherr.c b/win/tclWinMtherr.c index 7be9b97..65896b8 100644 --- a/win/tclWinMtherr.c +++ b/win/tclWinMtherr.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinMtherr.c,v 1.3 1999/04/16 00:48:09 stanton Exp $ + * RCS: @(#) $Id: tclWinMtherr.c,v 1.4 2002/02/15 14:28:51 dkf Exp $ */ #include "tclWinInt.h" @@ -43,7 +43,11 @@ _matherr(xPtr) if (!TclMathInProgress()) { return 0; } - if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) { + if ((xPtr->type == DOMAIN) +#ifdef __BORLANDC__ + || (xPtr->type == TLOSS) +#endif + || (xPtr->type == SING)) { errno = EDOM; } else { errno = ERANGE; diff --git a/win/tclWinPort.h b/win/tclWinPort.h index f27413e..193e366 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinPort.h,v 1.25 2002/01/24 01:34:16 dgp Exp $ + * RCS: @(#) $Id: tclWinPort.h,v 1.26 2002/02/15 14:28:51 dkf Exp $ */ #ifndef _TCLWINPORT @@ -468,6 +468,17 @@ typedef int TclpMutex; #define TclpMutexUnlock(a) #endif /* TCL_THREADS */ +#ifdef TCL_WIDE_INT_TYPE +EXTERN Tcl_WideInt strtoll _ANSI_ARGS_((char *string, char **endPtr, + int base)); +EXTERN Tcl_WideUInt strtoull _ANSI_ARGS_((char *string, char **endPtr, + int base)); +#endif /* TCL_WIDE_INT_TYPE */ + +#ifndef INVALID_SET_FILE_POINTER +#define INVALID_SET_FILE_POINTER 0xFFFFFFFF +#endif + #include "tclPlatDecls.h" #include "tclIntPlatDecls.h" |