From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 19743 invoked by alias); 23 Dec 2005 16:09:18 -0000 Received: (qmail 19735 invoked by uid 22791); 23 Dec 2005 16:09:17 -0000 X-Spam-Check-By: sourceware.org Received: from marmot.shef.ac.uk (HELO marmot.shef.ac.uk) (143.167.1.4) by sourceware.org (qpsmtpd/0.31) with ESMTP; Fri, 23 Dec 2005 16:09:15 +0000 Received: from va208044.shef.ac.uk ([143.167.208.44] helo=Albinoni) by marmot.shef.ac.uk with esmtp (Exim 4.52) id 1EppTd-0003mB-EA for insight@sourceware.org; Fri, 23 Dec 2005 16:09:12 +0000 Reply-To: From: "Peter Rockett" To: "'insight'" Subject: RE: FW: Can't build Insight with Cygwin Date: Fri, 23 Dec 2005 16:21:00 -0000 Message-ID: <000201c607db$40902aa0$0300a8c0@Albinoni> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="----=_NextPart_000_0003_01C607DB.40902AA0" In-Reply-To: X-S0phie-Scan: Yes Mailing-List: contact insight-help@sourceware.org; run by ezmlm Precedence: bulk List-Subscribe: List-Archive: List-Post: List-Help: , Sender: insight-owner@sourceware.org X-SW-Source: 2005-q4/txt/msg00063.txt.bz2 This is a multi-part message in MIME format. ------=_NextPart_000_0003_01C607DB.40902AA0 Content-Type: text/plain; charset="iso-8859-1" Content-Transfer-Encoding: quoted-printable Content-length: 4524 Thanks for the advice Wilfred but I have sorted this problem myself in the meantime after a little Googling. The tcl/win branch now builds fine. Keith: Attached the three files with all changes clearly annotated (with "pir"). That's the good news... The bad news is that gdb breaks. I have managed to solve one problem - an obvious problem in a source file which clearly the latest version of gcc will not tolerate. Other problems remain but I guess this is not the appropriate list for raising purely gdb problems.... Peter > -----Original Message----- > From: insight-owner@sourceware.org=20 > [mailto:insight-owner@sourceware.org] On Behalf Of=20 > wilfried.fauvel@laposte.net > Sent: 23 December 2005 13:38 > To: insight > Subject: Re:FW: Can't build Insight with Cygwin >=20 >=20 > Hi, >=20 > I think you can use the patch command=20 > (http://www.gnu.org/software/patch/patch.html) with the .diff=20 > file, I have made it manually : you only have to open the=20 > three files listed ("RCS file:") in the .diff file, and=20 > replace the - lines by the + lines at the corresponding=20 > patterns. I have tested to build on another config (with the=20 > same cygwin version : 1.5.18(0.132/4/2), and the same=20 > sources), and it seems to crash still ... >=20 > Good luck. >=20 > > Hi > > > > Thanks, Wilfred! This at least confirms my view that there did not=20 > > seem to be any regular way this source could build. If I read it=20 > > right, Dave Korn has confirmed that the Win32Dll.c code=20 > relies on an=20 > > idiosyncrasy of an earlier version of gcc. Wilfred, can you post a=20 > > patch? I have read Dave Korn's fix but as I have always studiously=20 > > avoided assembler I just don't understand what to do to=20 > implement it! > > > > BTW: Keith, I have used the latest cygwin download which I think is=20 > > gcc 3.4... (see Dave Korn's post). I am interested in Insight under=20 > > Windows because I have used MSVC in the past (great debugger!) but=20 > > want to migrate to gnu for cross-platform reasons. There's a lot of=20 > > IDEs available for gcc but debugging support is generally=20 > poor. Hence=20 > > the interest in Insight. Keith, I guess the cygwin compiler on your=20 > > Win2K box is an old version... > > > > Finally, I tried building with mingw 3.4.4 and the=20 > offending section=20 > > in tcl/win seems to build OK!! But mingw breaks on the ./bfd=20 > > sub-directory. Output below. Any ideas on this one? This looks like=20 > > something has coughed in the make file - again, I've studiously=20 > > avoided using make... > > > > > > Peter > > > >=20 > ###################################################################### > > ###### > > ############################# > > > > > > make[2]: Entering directory `/c/insight-6.4/bfd' > > > Making info in doc > > > make[3]: Entering directory `/c/insight-6.4/bfd/doc' > > > restore=3D: && backupdir=3D".am$$" && \ > > > am__cwd=3D`pwd` && cd ../.././bfd/doc && \ > > > rm -rf $backupdir && mkdir $backupdir && \ > > > for f in ../.././bfd/doc/bfd.info ../.././bfd/doc/bfd.info-[0-9] > > > ../.././bfd/doc/bfd.info-[0-9][0-9] > > > ../.././bfd/doc/bfd.i[0-9] ../.././bfd/doc/bfd.i[0-9][0-9]; do \ > > > if test -f $f; then mv $f $backupdir; restore=3Dmv; else :; > > > fi; \ done; \ cd "$am__cwd"; \ > > > if makeinfo --split-size=3D5000000 --split-size=3D5000000 -I > > > ../.././bfd/doc \ > > > -o ../.././bfd/doc/bfd.info ../.././bfd/doc/bfd.texinfo; \ then \ > > > rc=3D0; \ > > > cd ../.././bfd/doc; \ > > > else \ > > > rc=3D$?; \ > > > cd ../.././bfd/doc && \ > > > $restore $backupdir/* `echo "./../.././bfd/doc/bfd.info" | > > > sed 's|[^/]*$||'`; \ fi; \ rm -rf $backupdir; exit $rc > > > section mapping'.ss reference to nonexistent node `mmo a New > > > Hash Table Type'.ference to nonexistent node `Deriving > > > makeinfo: Removing output file `../.././bfd/doc/bfd.info' due > > > to errors; use --force to preserve. > > > make[3]: *** [../.././bfd/doc/bfd.info] Error 2 > > > make[3]: Leaving directory `/c/insight-6.4/bfd/doc' > > > make[2]: *** [info-recursive] Error 1 > > > make[2]: Leaving directory `/c/insight-6.4/bfd' > > > make[1]: *** [all-bfd] Error 2 > > > make[1]: Leaving directory `/c/insight-6.4' > > > make: *** [all] Error 2 > > > > >=20 >=20 > Acc=E9dez au courrier =E9lectronique de La Poste :=20 > www.laposte.net ; Jusqu'au 25 d=E9cembre, participez au grand=20 > jeu du Calendrier de l'Avent et > =A0gagnez tous les jours de nombreux lots, + de 300 cadeaux en jeu ! >=20 >=20 >=20 >=20 ------=_NextPart_000_0003_01C607DB.40902AA0 Content-Type: application/octet-stream; name="tclWinFCmd.c" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="tclWinFCmd.c" Content-length: 63692 /* used attribute added on line 472 - pir (23.12.2005) */=0A= =0A= /*=0A= * tclWinFCmd.c=0A= *=0A= * This file implements the Windows specific portion of file manipulat= ion=20=0A= * subcommands of the "file" command.=20=0A= *=0A= * Copyright (c) 1996-1998 Sun Microsystems, Inc.=0A= *=0A= * See the file "license.terms" for information on usage and redistribution= =0A= * of this file, and for a DISCLAIMER OF ALL WARRANTIES.=0A= *=0A= * RCS: @(#) $Id: tclWinFCmd.c,v 1.34 2003/02/04 17:06:53 vincentdarley Exp= $=0A= */=0A= =0A= #include "tclWinInt.h"=0A= =0A= /*=0A= * The following constants specify the type of callback when=0A= * TraverseWinTree() calls the traverseProc()=0A= */=0A= =0A= #define DOTREE_PRED 1 /* pre-order directory */=0A= #define DOTREE_POSTD 2 /* post-order directory */=0A= #define DOTREE_F 3 /* regular file */=0A= =0A= /*=0A= * Callbacks for file attributes code.=0A= */=0A= =0A= static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,=0A= int objIndex, Tcl_Obj *fileName,=0A= Tcl_Obj **attributePtrPtr));=0A= static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,=0A= int objIndex, Tcl_Obj *fileName,=0A= Tcl_Obj **attributePtrPtr));=0A= static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,=0A= int objIndex, Tcl_Obj *fileName,=0A= Tcl_Obj **attributePtrPtr));=0A= static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,=0A= int objIndex, Tcl_Obj *fileName,=0A= Tcl_Obj *attributePtr));=0A= static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,=0A= int objIndex, Tcl_Obj *fileName,=0A= Tcl_Obj *attributePtr));=0A= =0A= /*=0A= * Constants and variables necessary for file attributes subcommand.=0A= */=0A= =0A= enum {=0A= WIN_ARCHIVE_ATTRIBUTE,=0A= WIN_HIDDEN_ATTRIBUTE,=0A= WIN_LONGNAME_ATTRIBUTE,=0A= WIN_READONLY_ATTRIBUTE,=0A= WIN_SHORTNAME_ATTRIBUTE,=0A= WIN_SYSTEM_ATTRIBUTE=0A= };=0A= =0A= static int attributeArray[] =3D {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HID= DEN,=0A= 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};=0A= =0A= =0A= CONST char *tclpFileAttrStrings[] =3D {=0A= "-archive", "-hidden", "-longname", "-readonly",=0A= "-shortname", "-system", (char *) NULL=0A= };=0A= =0A= CONST TclFileAttrProcs tclpFileAttrProcs[] =3D {=0A= {GetWinFileAttributes, SetWinFileAttributes},=0A= {GetWinFileAttributes, SetWinFileAttributes},=0A= {GetWinFileLongName, CannotSetAttribute},=0A= {GetWinFileAttributes, SetWinFileAttributes},=0A= {GetWinFileShortName, CannotSetAttribute},=0A= {GetWinFileAttributes, SetWinFileAttributes}};=0A= =0A= #if defined(HAVE_NO_SEH) && defined(TCL_MEM_DEBUG)=0A= static void *INITIAL_ESP,=0A= *INITIAL_EBP,=0A= *INITIAL_HANDLER,=0A= *RESTORED_ESP,=0A= *RESTORED_EBP,=0A= *RESTORED_HANDLER;=0A= #endif /* HAVE_NO_SEH && TCL_MEM_DEBUG */=0A= =0A= /*=0A= * Prototype for the TraverseWinTree callback function.=0A= */=0A= =0A= typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,=20=0A= int type, Tcl_DString *errorPtr);=0A= =0A= /*=0A= * Declarations for local procedures defined in this file:=0A= */=0A= =0A= static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName);=0A= static int ConvertFileNameFormat(Tcl_Interp *interp,=20=0A= int objIndex, Tcl_Obj *fileName, int longShort,=0A= Tcl_Obj **attributePtrPtr);=0A= static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr);=0A= static int DoCreateDirectory(CONST TCHAR *pathPtr);=0A= static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc,=20=0A= int ignoreError, Tcl_DString *errorPtr);=0A= static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,=20=0A= Tcl_DString *errorPtr);=0A= static int DoRenameFile(CONST TCHAR *nativeSrc, CONST TCHAR *dstPtr);=0A= static int TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,=20=0A= int type, Tcl_DString *errorPtr);=0A= static int TraversalDelete(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,=20=0A= int type, Tcl_DString *errorPtr);=0A= static int TraverseWinTree(TraversalProc *traverseProc,=0A= Tcl_DString *sourcePtr, Tcl_DString *dstPtr,=20=0A= Tcl_DString *errorPtr);=0A= =0A= =0C=0A= /*=0A= *-------------------------------------------------------------------------= --=0A= *=0A= * TclpObjRenameFile, DoRenameFile --=0A= *=0A= * Changes the name of an existing file or directory, from src to dst.= =0A= * If src and dst refer to the same file or directory, does nothing=0A= * and returns success. Otherwise if dst already exists, it will be=0A= * deleted and replaced by src subject to the following conditions:=0A= * If src is a directory, dst may be an empty directory.=0A= * If src is a file, dst may be a file.=0A= * In any other situation where dst already exists, the rename will=0A= * fail.=20=20=0A= *=0A= * Results:=0A= * If the file or directory was successfully renamed, returns TCL_OK.=0A= * Otherwise the return value is TCL_ERROR and errno is set to=0A= * indicate the error. Some possible values for errno are:=0A= *=0A= * ENAMETOOLONG: src or dst names are too long.=0A= * EACCES: src or dst parent directory can't be read and/or written.=0A= * EEXIST: dst is a non-empty directory.=0A= * EINVAL: src is a root directory or dst is a subdirectory of src.=0A= * EISDIR: dst is a directory, but src is not.=0A= * ENOENT: src doesn't exist. src or dst is "".=0A= * ENOTDIR: src is a directory, but dst is not.=20=20=0A= * EXDEV: src and dst are on different filesystems.=0A= *=0A= * EACCES: exists an open file already referring to src or dst.=0A= * EACCES: src or dst specify the current working directory (NT).=0A= * EACCES: src specifies a char device (nul:, com1:, etc.)=20=0A= * EEXIST: dst specifies a char device (nul:, com1:, etc.) (NT)=0A= * EACCES: dst specifies a char device (nul:, com1:, etc.) (95)=0A= *=09=0A= * Side effects:=0A= * The implementation supports cross-filesystem renames of files,=0A= * but the caller should be prepared to emulate cross-filesystem=0A= * renames of directories if errno is EXDEV.=0A= *=0A= *-------------------------------------------------------------------------= --=0A= */=0A= =0A= int=20=0A= TclpObjRenameFile(srcPathPtr, destPathPtr)=0A= Tcl_Obj *srcPathPtr;=0A= Tcl_Obj *destPathPtr;=0A= {=0A= return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),=20=0A= Tcl_FSGetNativePath(destPathPtr));=0A= }=0A= =0A= static int=0A= DoRenameFile(=0A= CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed=0A= * (native). */=20=0A= CONST TCHAR *nativeDst) /* New pathname for file or directory=0A= * (native). */=0A= {=20=20=20=20=0A= DWORD srcAttr, dstAttr;=0A= int retval =3D -1;=0A= =0A= /*=0A= * The MoveFile API acts differently under Win95/98 and NT=0A= * WRT NULL and "". Avoid passing these values.=0A= */=0A= =0A= if (nativeSrc =3D=3D NULL || nativeSrc[0] =3D=3D '\0' ||=0A= nativeDst =3D=3D NULL || nativeDst[0] =3D=3D '\0') {=0A= Tcl_SetErrno(ENOENT);=0A= return TCL_ERROR;=0A= }=0A= =0A= /*=0A= * The MoveFile API would throw an exception under NT=0A= * if one of the arguments is a char block device.=0A= */=0A= =0A= #ifdef HAVE_NO_SEH=0A= # ifdef TCL_MEM_DEBUG=0A= __asm__ __volatile__ (=0A= "movl %%esp, %0" "\n\t"=0A= "movl %%ebp, %1" "\n\t"=0A= "movl %%fs:0, %2" "\n\t"=0A= : "=3Dm"(INITIAL_ESP),=0A= "=3Dm"(INITIAL_EBP),=0A= "=3Dr"(INITIAL_HANDLER) );=0A= # endif /* TCL_MEM_DEBUG */=0A= =0A= __asm__ __volatile__ (=0A= "pushl %ebp" "\n\t"=0A= "pushl $__except_dorenamefile_handler" "\n\t"=0A= "pushl %fs:0" "\n\t"=0A= "movl %esp, %fs:0");=0A= #else=0A= __try {=0A= #endif /* HAVE_NO_SEH */=0A= if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) !=3D FALSE) {=0A= retval =3D TCL_OK;=0A= }=0A= #ifdef HAVE_NO_SEH=0A= __asm__ __volatile__ (=0A= "jmp dorenamefile_pop" "\n"=0A= "dorenamefile_reentry:" "\n\t"=0A= "movl %%fs:0, %%eax" "\n\t"=0A= "movl 0x8(%%eax), %%esp" "\n\t"=0A= "movl 0x8(%%esp), %%ebp" "\n"=0A= "dorenamefile_pop:" "\n\t"=0A= "movl (%%esp), %%eax" "\n\t"=0A= "movl %%eax, %%fs:0" "\n\t"=0A= "add $12, %%esp" "\n\t"=0A= :=0A= :=0A= : "%eax");=0A= =0A= # ifdef TCL_MEM_DEBUG=0A= __asm__ __volatile__ (=0A= "movl %%esp, %0" "\n\t"=0A= "movl %%ebp, %1" "\n\t"=0A= "movl %%fs:0, %2" "\n\t"=0A= : "=3Dm"(RESTORED_ESP),=0A= "=3Dm"(RESTORED_EBP),=0A= "=3Dr"(RESTORED_HANDLER) );=0A= =0A= if (INITIAL_ESP !=3D RESTORED_ESP)=0A= panic("ESP restored incorrectly");=0A= if (INITIAL_EBP !=3D RESTORED_EBP)=0A= panic("EBP restored incorrectly");=0A= if (INITIAL_HANDLER !=3D RESTORED_HANDLER)=0A= panic("HANDLER restored incorrectly");=0A= # endif /* TCL_MEM_DEBUG */=0A= #else=0A= } __except (EXCEPTION_EXECUTE_HANDLER) {}=0A= #endif /* HAVE_NO_SEH */=0A= =0A= /*=0A= * Avoid using control flow statements in the SEH guarded block!=0A= */=0A= if (retval !=3D -1)=0A= return retval;=0A= =0A= TclWinConvertError(GetLastError());=0A= =0A= srcAttr =3D (*tclWinProcs->getFileAttributesProc)(nativeSrc);=0A= dstAttr =3D (*tclWinProcs->getFileAttributesProc)(nativeDst);=0A= if (srcAttr =3D=3D 0xffffffff) {=0A= if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >=3D MAX= _PATH) {=0A= errno =3D ENAMETOOLONG;=0A= return TCL_ERROR;=0A= }=0A= srcAttr =3D 0;=0A= }=0A= if (dstAttr =3D=3D 0xffffffff) {=0A= if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >=3D MAX= _PATH) {=0A= errno =3D ENAMETOOLONG;=0A= return TCL_ERROR;=0A= }=0A= dstAttr =3D 0;=0A= }=0A= =0A= if (errno =3D=3D EBADF) {=0A= errno =3D EACCES;=0A= return TCL_ERROR;=0A= }=0A= if (errno =3D=3D EACCES) {=0A= decode:=0A= if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {=0A= TCHAR *nativeSrcRest, *nativeDstRest;=0A= CONST char **srcArgv, **dstArgv;=0A= int size, srcArgc, dstArgc;=0A= WCHAR nativeSrcPath[MAX_PATH];=0A= WCHAR nativeDstPath[MAX_PATH];=0A= Tcl_DString srcString, dstString;=0A= CONST char *src, *dst;=0A= =0A= size =3D (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,=20= =0A= nativeSrcPath, &nativeSrcRest);=0A= if ((size =3D=3D 0) || (size > MAX_PATH)) {=0A= return TCL_ERROR;=0A= }=0A= size =3D (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,=20= =0A= nativeDstPath, &nativeDstRest);=0A= if ((size =3D=3D 0) || (size > MAX_PATH)) {=0A= return TCL_ERROR;=0A= }=0A= (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);=0A= (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);=0A= =0A= src =3D Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);=0A= dst =3D Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);=0A= if (strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString)) =3D=3D 0= ) {=0A= /*=0A= * Trying to move a directory into itself.=0A= */=0A= =0A= errno =3D EINVAL;=0A= Tcl_DStringFree(&srcString);=0A= Tcl_DStringFree(&dstString);=0A= return TCL_ERROR;=0A= }=0A= Tcl_SplitPath(src, &srcArgc, &srcArgv);=0A= Tcl_SplitPath(dst, &dstArgc, &dstArgv);=0A= Tcl_DStringFree(&srcString);=0A= Tcl_DStringFree(&dstString);=0A= =0A= if (srcArgc =3D=3D 1) {=0A= /*=0A= * They are trying to move a root directory. Whether=0A= * or not it is across filesystems, this cannot be=0A= * done.=0A= */=0A= =0A= Tcl_SetErrno(EINVAL);=0A= } else if ((srcArgc > 0) && (dstArgc > 0) &&=0A= (strcmp(srcArgv[0], dstArgv[0]) !=3D 0)) {=0A= /*=0A= * If src is a directory and dst filesystem !=3D src=0A= * filesystem, errno should be EXDEV. It is very=0A= * important to get this behavior, so that the caller=0A= * can respond to a cross filesystem rename by=0A= * simulating it with copy and delete. The MoveFile=0A= * system call already handles the case of moving a=0A= * file between filesystems.=0A= */=0A= =0A= Tcl_SetErrno(EXDEV);=0A= }=0A= =0A= ckfree((char *) srcArgv);=0A= ckfree((char *) dstArgv);=0A= }=0A= =0A= /*=0A= * Other types of access failure is that dst is a read-only=0A= * filesystem, that an open file referred to src or dest, or that=0A= * src or dest specified the current working directory on the=0A= * current filesystem. EACCES is returned for those cases.=0A= */=0A= =0A= } else if (Tcl_GetErrno() =3D=3D EEXIST) {=0A= /*=0A= * Reports EEXIST any time the target already exists. If it makes=0A= * sense, remove the old file and try renaming again.=0A= */=0A= =0A= if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {=0A= if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {=0A= /*=0A= * Overwrite empty dst directory with src directory. The=0A= * following call will remove an empty directory. If it=0A= * fails, it's because it wasn't empty.=0A= */=0A= =0A= if (DoRemoveJustDirectory(nativeDst, 0, NULL) =3D=3D TCL_OK) {=0A= /*=0A= * Now that that empty directory is gone, we can try=0A= * renaming again. If that fails, we'll put this empty=0A= * directory back, for completeness.=0A= */=0A= =0A= if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) !=3D FALSE) {= =0A= return TCL_OK;=0A= }=0A= =0A= /*=0A= * Some new error has occurred. Don't know what it=0A= * could be, but report this one.=0A= */=0A= =0A= TclWinConvertError(GetLastError());=0A= (*tclWinProcs->createDirectoryProc)(nativeDst, NULL);=0A= (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);=0A= if (Tcl_GetErrno() =3D=3D EACCES) {=0A= /*=0A= * Decode the EACCES to a more meaningful error.=0A= */=0A= =0A= goto decode;=0A= }=0A= }=0A= } else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) =3D=3D 0 */=0A= Tcl_SetErrno(ENOTDIR);=0A= }=0A= } else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) =3D=3D 0 */=0A= if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {=0A= Tcl_SetErrno(EISDIR);=0A= } else {=0A= /*=0A= * Overwrite existing file by:=0A= *=20=0A= * 1. Rename existing file to temp name.=0A= * 2. Rename old file to new name.=0A= * 3. If success, delete temp file. If failure,=0A= * put temp file back to old name.=0A= */=0A= =0A= TCHAR *nativeRest, *nativeTmp, *nativePrefix;=0A= int result, size;=0A= WCHAR tempBuf[MAX_PATH];=0A= =09=09=0A= size =3D (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,=20=0A= tempBuf, &nativeRest);=0A= if ((size =3D=3D 0) || (size > MAX_PATH) || (nativeRest =3D=3D NULL)) {= =0A= return TCL_ERROR;=0A= }=0A= nativeTmp =3D (TCHAR *) tempBuf;=0A= ((char *) nativeRest)[0] =3D '\0';=0A= ((char *) nativeRest)[1] =3D '\0'; /* In case it's Unicode. */=0A= =0A= result =3D TCL_ERROR;=0A= nativePrefix =3D (tclWinProcs->useWide)=20=0A= ? (TCHAR *) L"tclr" : (TCHAR *) "tclr";=0A= if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,=20=0A= nativePrefix, 0, tempBuf) !=3D 0) {=0A= /*=0A= * Strictly speaking, need the following DeleteFile and=0A= * MoveFile to be joined as an atomic operation so no=0A= * other app comes along in the meantime and creates the=0A= * same temp file.=0A= */=0A= =09=09=20=20=20=20=20=0A= nativeTmp =3D (TCHAR *) tempBuf;=0A= (*tclWinProcs->deleteFileProc)(nativeTmp);=0A= if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) !=3D FALSE) {= =0A= if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) !=3D FALSE) {=0A= (*tclWinProcs->setFileAttributesProc)(nativeTmp,=20=0A= FILE_ATTRIBUTE_NORMAL);=0A= (*tclWinProcs->deleteFileProc)(nativeTmp);=0A= return TCL_OK;=0A= } else {=0A= (*tclWinProcs->deleteFileProc)(nativeDst);=0A= (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst);=0A= }=0A= }=20=0A= =0A= /*=0A= * Can't backup dst file or move src file. Return that=0A= * error. Could happen if an open file refers to dst.=0A= */=0A= =0A= TclWinConvertError(GetLastError());=0A= if (Tcl_GetErrno() =3D=3D EACCES) {=0A= /*=0A= * Decode the EACCES to a more meaningful error.=0A= */=0A= =0A= goto decode;=0A= }=0A= }=0A= return result;=0A= }=0A= }=0A= }=0A= return TCL_ERROR;=0A= }=0A= #ifdef HAVE_NO_SEH=0A= static=0A= __attribute__ ((used, /* pir - 23.12.2005 */ cdecl))=0A= EXCEPTION_DISPOSITION=0A= _except_dorenamefile_handler(=0A= struct _EXCEPTION_RECORD *ExceptionRecord,=0A= void *EstablisherFrame,=0A= struct _CONTEXT *ContextRecord,=0A= void *DispatcherContext)=0A= {=0A= __asm__ __volatile__ (=0A= "jmp dorenamefile_reentry");=0A= /* Nuke compiler warning about unused static function */=0A= _except_dorenamefile_handler(NULL, NULL, NULL, NULL);=0A= return 0; /* Function does not return */=0A= }=0A= #endif /* HAVE_NO_SEH */=0A= =0C=0A= /*=0A= *-------------------------------------------------------------------------= --=0A= *=0A= * TclpObjCopyFile, DoCopyFile --=0A= *=0A= * Copy a single file (not a directory). If dst already exists and=0A= * is not a directory, it is removed.=0A= *=0A= * Results:=0A= * If the file was successfully copied, returns TCL_OK. Otherwise=0A= * the return value is TCL_ERROR and errno is set to indicate the=0A= * error. Some possible values for errno are:=0A= *=0A= * EACCES: src or dst parent directory can't be read and/or written.=0A= * EISDIR: src or dst is a directory.=0A= * ENOENT: src doesn't exist. src or dst is "".=0A= *=0A= * EACCES: exists an open file already referring to dst (95).=0A= * EACCES: src specifies a char device (nul:, com1:, etc.) (NT)=0A= * ENOENT: src specifies a char device (nul:, com1:, etc.) (95)=0A= *=0A= * Side effects:=0A= * It is not an error to copy to a char device.=0A= *=0A= *-------------------------------------------------------------------------= --=0A= */=0A= =0A= int=20=0A= TclpObjCopyFile(srcPathPtr, destPathPtr)=0A= Tcl_Obj *srcPathPtr;=0A= Tcl_Obj *destPathPtr;=0A= {=0A= return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),=0A= Tcl_FSGetNativePath(destPathPtr));=0A= }=0A= =0A= static int=0A= DoCopyFile(=0A= CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */=0A= CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */=0A= {=0A= int retval =3D -1;=0A= =0A= /*=0A= * The CopyFile API acts differently under Win95/98 and NT=0A= * WRT NULL and "". Avoid passing these values.=0A= */=0A= =0A= if (nativeSrc =3D=3D NULL || nativeSrc[0] =3D=3D '\0' ||=0A= nativeDst =3D=3D NULL || nativeDst[0] =3D=3D '\0') {=0A= Tcl_SetErrno(ENOENT);=0A= return TCL_ERROR;=0A= }=0A= =20=20=20=20=0A= /*=0A= * The CopyFile API would throw an exception under NT if one=0A= * of the arguments is a char block device.=0A= */=0A= =0A= #ifdef HAVE_NO_SEH=0A= # ifdef TCL_MEM_DEBUG=0A= __asm__ __volatile__ (=0A= "movl %%esp, %0" "\n\t"=0A= "movl %%ebp, %1" "\n\t"=0A= "movl %%fs:0, %2" "\n\t"=0A= : "=3Dm"(INITIAL_ESP),=0A= "=3Dm"(INITIAL_EBP),=0A= "=3Dr"(INITIAL_HANDLER) );=0A= # endif /* TCL_MEM_DEBUG */=0A= =0A= __asm__ __volatile__ (=0A= "pushl %ebp" "\n\t"=0A= "pushl $__except_docopyfile_handler" "\n\t"=0A= "pushl %fs:0" "\n\t"=0A= "movl %esp, %fs:0");=0A= #else=0A= __try {=0A= #endif /* HAVE_NO_SEH */=0A= if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) !=3D FALSE) {=0A= retval =3D TCL_OK;=0A= }=0A= #ifdef HAVE_NO_SEH=0A= __asm__ __volatile__ (=0A= "jmp docopyfile_pop" "\n"=0A= "docopyfile_reentry:" "\n\t"=0A= "movl %%fs:0, %%eax" "\n\t"=0A= "movl 0x8(%%eax), %%esp" "\n\t"=0A= "movl 0x8(%%esp), %%ebp" "\n"=0A= "docopyfile_pop:" "\n\t"=0A= "movl (%%esp), %%eax" "\n\t"=0A= "movl %%eax, %%fs:0" "\n\t"=0A= "add $12, %%esp" "\n\t"=0A= :=0A= :=0A= : "%eax");=0A= =0A= # ifdef TCL_MEM_DEBUG=0A= __asm__ __volatile__ (=0A= "movl %%esp, %0" "\n\t"=0A= "movl %%ebp, %1" "\n\t"=0A= "movl %%fs:0, %2" "\n\t"=0A= : "=3Dm"(RESTORED_ESP),=0A= "=3Dm"(RESTORED_EBP),=0A= "=3Dr"(RESTORED_HANDLER) );=0A= =0A= if (INITIAL_ESP !=3D RESTORED_ESP)=0A= panic("ESP restored incorrectly");=0A= if (INITIAL_EBP !=3D RESTORED_EBP)=0A= panic("EBP restored incorrectly");=0A= if (INITIAL_HANDLER !=3D RESTORED_HANDLER)=0A= panic("HANDLER restored incorrectly");=0A= # endif /* TCL_MEM_DEBUG */=0A= #else=0A= } __except (EXCEPTION_EXECUTE_HANDLER) {}=0A= #endif /* HAVE_NO_SEH */=0A= =0A= /*=0A= * Avoid using control flow statements in the SEH guarded block!=0A= */=0A= if (retval !=3D -1)=0A= return retval;=0A= =0A= TclWinConvertError(GetLastError());=0A= if (Tcl_GetErrno() =3D=3D EBADF) {=0A= Tcl_SetErrno(EACCES);=0A= return TCL_ERROR;=0A= }=0A= if (Tcl_GetErrno() =3D=3D EACCES) {=0A= DWORD srcAttr, dstAttr;=0A= =0A= srcAttr =3D (*tclWinProcs->getFileAttributesProc)(nativeSrc);=0A= dstAttr =3D (*tclWinProcs->getFileAttributesProc)(nativeDst);=0A= if (srcAttr !=3D 0xffffffff) {=0A= if (dstAttr =3D=3D 0xffffffff) {=0A= dstAttr =3D 0;=0A= }=0A= if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||=0A= (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {=0A= if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) {=0A= /* Source is a symbolic link -- copy it */=0A= if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) =3D=3D 0) {=0A= return TCL_OK;=0A= }=0A= }=0A= Tcl_SetErrno(EISDIR);=0A= }=0A= if (dstAttr & FILE_ATTRIBUTE_READONLY) {=0A= (*tclWinProcs->setFileAttributesProc)(nativeDst,=20=0A= dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));=0A= if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) !=3D FALSE) {= =0A= return TCL_OK;=0A= }=0A= /*=0A= * Still can't copy onto dst. Return that error, and=0A= * restore attributes of dst.=0A= */=0A= =0A= TclWinConvertError(GetLastError());=0A= (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);=0A= }=0A= }=0A= }=0A= return TCL_ERROR;=0A= }=0A= #ifdef HAVE_NO_SEH=0A= static=0A= __attribute__ ((cdecl))=0A= EXCEPTION_DISPOSITION=0A= _except_docopyfile_handler(=0A= struct _EXCEPTION_RECORD *ExceptionRecord,=0A= void *EstablisherFrame,=0A= struct _CONTEXT *ContextRecord,=0A= void *DispatcherContext)=0A= {=0A= __asm__ __volatile__ (=0A= "jmp docopyfile_reentry");=0A= _except_docopyfile_handler(NULL,NULL,NULL,NULL);=0A= return 0; /* Function does not return */=0A= }=0A= #endif /* HAVE_NO_SEH */=0A= =0C=0A= /*=0A= *-------------------------------------------------------------------------= --=0A= *=0A= * TclpObjDeleteFile, TclpDeleteFile --=0A= *=0A= * Removes a single file (not a directory).=0A= *=0A= * Results:=0A= * If the file was successfully deleted, returns TCL_OK. Otherwise=0A= * the return value is TCL_ERROR and errno is set to indicate the=0A= * error. Some possible values for errno are:=0A= *=0A= * EACCES: a parent directory can't be read and/or written.=0A= * EISDIR: path is a directory.=0A= * ENOENT: path doesn't exist or is "".=0A= *=0A= * EACCES: exists an open file already referring to path.=0A= * EACCES: path is a char device (nul:, com1:, etc.)=0A= *=0A= * Side effects:=0A= * The file is deleted, even if it is read-only.=0A= *=0A= *-------------------------------------------------------------------------= --=0A= */=0A= =0A= int=20=0A= TclpObjDeleteFile(pathPtr)=0A= Tcl_Obj *pathPtr;=0A= {=0A= return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));=0A= }=0A= =0A= int=0A= TclpDeleteFile(=0A= CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */= =0A= {=0A= DWORD attr;=0A= =0A= /*=0A= * The DeleteFile API acts differently under Win95/98 and NT=0A= * WRT NULL and "". Avoid passing these values.=0A= */=0A= =0A= if (nativePath =3D=3D NULL || nativePath[0] =3D=3D '\0') {=0A= Tcl_SetErrno(ENOENT);=0A= return TCL_ERROR;=0A= }=0A= =0A= if ((*tclWinProcs->deleteFileProc)(nativePath) !=3D FALSE) {=0A= return TCL_OK;=0A= }=0A= TclWinConvertError(GetLastError());=0A= =0A= if (Tcl_GetErrno() =3D=3D EACCES) {=0A= attr =3D (*tclWinProcs->getFileAttributesProc)(nativePath);=0A= if (attr !=3D 0xffffffff) {=0A= if (attr & FILE_ATTRIBUTE_DIRECTORY) {=0A= if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {=0A= /* It is a symbolic link -- remove it */=0A= if (TclWinSymLinkDelete(nativePath, 0) =3D=3D 0) {=0A= return TCL_OK;=0A= }=0A= }=0A= =09=09=0A= /*=20=0A= * If we fall through here, it is a directory.=0A= *=20=0A= * Windows NT reports removing a directory as EACCES instead=0A= * of EISDIR.=0A= */=0A= =0A= Tcl_SetErrno(EISDIR);=0A= } else if (attr & FILE_ATTRIBUTE_READONLY) {=0A= int res =3D (*tclWinProcs->setFileAttributesProc)(nativePath,=20=0A= attr & ~((DWORD)FILE_ATTRIBUTE_READONLY));=0A= if ((res !=3D 0) && ((*tclWinProcs->deleteFileProc)(nativePath)=0A= !=3D FALSE)) {=0A= return TCL_OK;=0A= }=0A= TclWinConvertError(GetLastError());=0A= if (res !=3D 0) {=0A= (*tclWinProcs->setFileAttributesProc)(nativePath, attr);=0A= }=0A= }=0A= }=0A= } else if (Tcl_GetErrno() =3D=3D ENOENT) {=0A= attr =3D (*tclWinProcs->getFileAttributesProc)(nativePath);=0A= if (attr !=3D 0xffffffff) {=0A= if (attr & FILE_ATTRIBUTE_DIRECTORY) {=0A= /*=0A= * Windows 95 reports removing a directory as ENOENT instead=20=0A= * of EISDIR.=20=0A= */=0A= =0A= Tcl_SetErrno(EISDIR);=0A= }=0A= }=0A= } else if (Tcl_GetErrno() =3D=3D EINVAL) {=0A= /*=0A= * Windows NT reports removing a char device as EINVAL instead of=0A= * EACCES.=0A= */=0A= =0A= Tcl_SetErrno(EACCES);=0A= }=0A= =0A= return TCL_ERROR;=0A= }=0A= =0C=0A= /*=0A= *-------------------------------------------------------------------------= --=0A= *=0A= * TclpObjCreateDirectory --=0A= *=0A= * Creates the specified directory. All parent directories of the=0A= * specified directory must already exist. The directory is=0A= * automatically created with permissions so that user can access=0A= * the new directory and create new files or subdirectories in it.=0A= *=0A= * Results:=0A= * If the directory was successfully created, returns TCL_OK.=0A= * Otherwise the return value is TCL_ERROR and errno is set to=0A= * indicate the error. Some possible values for errno are:=0A= *=0A= * EACCES: a parent directory can't be read and/or written.=0A= * EEXIST: path already exists.=0A= * ENOENT: a parent directory doesn't exist.=0A= *=0A= * Side effects:=0A= * A directory is created.=0A= *=0A= *-------------------------------------------------------------------------= --=0A= */=0A= =0A= int=20=0A= TclpObjCreateDirectory(pathPtr)=0A= Tcl_Obj *pathPtr;=0A= {=0A= return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));=0A= }=0A= =0A= static int=0A= DoCreateDirectory(=0A= CONST TCHAR *nativePath) /* Pathname of directory to create (native). *= /=0A= {=0A= DWORD error;=0A= if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) =3D=3D 0) {= =0A= error =3D GetLastError();=0A= TclWinConvertError(error);=0A= return TCL_ERROR;=0A= }=20=20=20=0A= return TCL_OK;=0A= }=0A= =0C=0A= /*=0A= *-------------------------------------------------------------------------= --=0A= *=0A= * TclpObjCopyDirectory --=0A= *=0A= * Recursively copies a directory. The target directory dst must=0A= * not already exist. Note that this function does not merge two=0A= * directory hierarchies, even if the target directory is an an=0A= * empty directory.=0A= *=0A= * Results:=0A= * If the directory was successfully copied, returns TCL_OK.=0A= * Otherwise the return value is TCL_ERROR, errno is set to indicate=0A= * the error, and the pathname of the file that caused the error=0A= * is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile=0A= * for a description of possible values for errno.=0A= *=0A= * Side effects:=0A= * An exact copy of the directory hierarchy src will be created=0A= * with the name dst. If an error occurs, the error will=0A= * be returned immediately, and remaining files will not be=0A= * processed.=0A= *=0A= *-------------------------------------------------------------------------= --=0A= */=0A= =0A= int=20=0A= TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)=0A= Tcl_Obj *srcPathPtr;=0A= Tcl_Obj *destPathPtr;=0A= Tcl_Obj **errorPtr;=0A= {=0A= Tcl_DString ds;=0A= Tcl_DString srcString, dstString;=0A= int ret;=0A= =0A= Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr),=20=0A= -1, &srcString);=0A= Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,destPathPtr),=20= =0A= -1, &dstString);=0A= =0A= ret =3D TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);=0A= =0A= Tcl_DStringFree(&srcString);=0A= Tcl_DStringFree(&dstString);=0A= =0A= if (ret !=3D TCL_OK) {=0A= *errorPtr =3D Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);=0A= Tcl_DStringFree(&ds);=0A= Tcl_IncrRefCount(*errorPtr);=0A= }=0A= return ret;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TclpObjRemoveDirectory, DoRemoveDirectory --=20=0A= *=0A= * Removes directory (and its contents, if the recursive flag is set).=0A= *=0A= * Results:=0A= * If the directory was successfully removed, returns TCL_OK.=0A= * Otherwise the return value is TCL_ERROR, errno is set to indicate=0A= * the error, and the pathname of the file that caused the error=0A= * is stored in errorPtr. Some possible values for errno are:=0A= *=0A= * EACCES: path directory can't be read and/or written.=0A= * EEXIST: path is a non-empty directory.=0A= * EINVAL: path is root directory or current directory.=0A= * ENOENT: path doesn't exist or is "".=0A= * ENOTDIR: path is not a directory.=0A= *=0A= * EACCES: path is a char device (nul:, com1:, etc.) (95)=0A= * EINVAL: path is a char device (nul:, com1:, etc.) (NT)=0A= *=0A= * Side effects:=0A= * Directory removed. If an error occurs, the error will be returned=0A= * immediately, and remaining files will not be deleted.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= int=20=0A= TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)=0A= Tcl_Obj *pathPtr;=0A= int recursive;=0A= Tcl_Obj **errorPtr;=0A= {=0A= Tcl_DString ds;=0A= int ret;=0A= if (recursive) {=0A= /*=20=0A= * In the recursive case, the string rep is used to construct a=0A= * Tcl_DString which may be used extensively, so we can't=0A= * optimize this case easily.=0A= */=0A= Tcl_DString native;=0A= Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL, pathPtr),=20=0A= -1, &native);=0A= ret =3D DoRemoveDirectory(&native, recursive, &ds);=0A= Tcl_DStringFree(&native);=0A= } else {=0A= ret =3D DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr),=20=0A= 0, &ds);=0A= }=0A= if (ret !=3D TCL_OK) {=0A= int len =3D Tcl_DStringLength(&ds);=0A= if (len > 0) {=0A= *errorPtr =3D Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);=0A= Tcl_IncrRefCount(*errorPtr);=0A= }=0A= Tcl_DStringFree(&ds);=0A= }=0A= return ret;=0A= }=0A= =0A= static int=0A= DoRemoveJustDirectory(=0A= CONST TCHAR *nativePath, /* Pathname of directory to be removed=0A= * (native). */=0A= int ignoreError, /* If non-zero, don't initialize the=0A= * errorPtr under some circumstances=0A= * on return. */=0A= Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free=0A= * DString filled with UTF-8 name of file=0A= * causing error. */=0A= {=0A= /*=0A= * The RemoveDirectory API acts differently under Win95/98 and NT=0A= * WRT NULL and "". Avoid passing these values.=0A= */=0A= =0A= if (nativePath =3D=3D NULL || nativePath[0] =3D=3D '\0') {=0A= Tcl_SetErrno(ENOENT);=0A= goto end;=0A= }=0A= =0A= if ((*tclWinProcs->removeDirectoryProc)(nativePath) !=3D FALSE) {=0A= return TCL_OK;=0A= }=0A= TclWinConvertError(GetLastError());=0A= =0A= if (Tcl_GetErrno() =3D=3D EACCES) {=0A= DWORD attr =3D (*tclWinProcs->getFileAttributesProc)(nativePath);=0A= if (attr !=3D 0xffffffff) {=0A= if ((attr & FILE_ATTRIBUTE_DIRECTORY) =3D=3D 0) {=0A= /*=20=0A= * Windows 95 reports calling RemoveDirectory on a file as an=20=0A= * EACCES, not an ENOTDIR.=0A= */=0A= =09=09=0A= Tcl_SetErrno(ENOTDIR);=0A= goto end;=0A= }=0A= =0A= if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {=0A= /* It is a symbolic link -- remove it */=0A= if (TclWinSymLinkDelete(nativePath, 1) !=3D 0) {=0A= goto end;=0A= }=0A= }=0A= =09=20=20=20=20=0A= if (attr & FILE_ATTRIBUTE_READONLY) {=0A= attr &=3D ~FILE_ATTRIBUTE_READONLY;=0A= if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) =3D=3D FALSE)= {=0A= goto end;=0A= }=0A= if ((*tclWinProcs->removeDirectoryProc)(nativePath) !=3D FALSE) {=0A= return TCL_OK;=0A= }=0A= TclWinConvertError(GetLastError());=0A= (*tclWinProcs->setFileAttributesProc)(nativePath,=20=0A= attr | FILE_ATTRIBUTE_READONLY);=0A= }=0A= =0A= /*=20=0A= * Windows 95 and Win32s report removing a non-empty directory=20=0A= * as EACCES, not EEXIST. If the directory is not empty,=0A= * change errno so caller knows what's going on.=0A= */=0A= =0A= if (TclWinGetPlatformId() !=3D VER_PLATFORM_WIN32_NT) {=0A= CONST char *path, *find;=0A= HANDLE handle;=0A= WIN32_FIND_DATAA data;=0A= Tcl_DString buffer;=0A= int len;=0A= =0A= path =3D (CONST char *) nativePath;=0A= =0A= Tcl_DStringInit(&buffer);=0A= len =3D strlen(path);=0A= find =3D Tcl_DStringAppend(&buffer, path, len);=0A= if ((len > 0) && (find[len - 1] !=3D '\\')) {=0A= Tcl_DStringAppend(&buffer, "\\", 1);=0A= }=0A= find =3D Tcl_DStringAppend(&buffer, "*.*", 3);=0A= handle =3D FindFirstFileA(find, &data);=0A= if (handle !=3D INVALID_HANDLE_VALUE) {=0A= while (1) {=0A= if ((strcmp(data.cFileName, ".") !=3D 0)=0A= && (strcmp(data.cFileName, "..") !=3D 0)) {=0A= /*=0A= * Found something in this directory.=0A= */=0A= =0A= Tcl_SetErrno(EEXIST);=0A= break;=0A= }=0A= if (FindNextFileA(handle, &data) =3D=3D FALSE) {=0A= break;=0A= }=0A= }=0A= FindClose(handle);=0A= }=0A= Tcl_DStringFree(&buffer);=0A= }=0A= }=0A= }=0A= if (Tcl_GetErrno() =3D=3D ENOTEMPTY) {=0A= /*=20=0A= * The caller depends on EEXIST to signify that the directory is=0A= * not empty, not ENOTEMPTY.=20=0A= */=0A= =0A= Tcl_SetErrno(EEXIST);=0A= }=0A= if ((ignoreError !=3D 0) && (Tcl_GetErrno() =3D=3D EEXIST)) {=0A= /*=20=0A= * If we're being recursive, this error may actually=0A= * be ok, so we don't want to initialise the errorPtr=0A= * yet.=0A= */=0A= return TCL_ERROR;=0A= }=0A= =0A= end:=0A= if (errorPtr !=3D NULL) {=0A= Tcl_WinTCharToUtf(nativePath, -1, errorPtr);=0A= }=0A= return TCL_ERROR;=0A= =0A= }=0A= =0A= static int=0A= DoRemoveDirectory(=0A= Tcl_DString *pathPtr, /* Pathname of directory to be removed=0A= * (native). */=0A= int recursive, /* If non-zero, removes directories that=0A= * are nonempty. Otherwise, will only remove=0A= * empty directories. */=0A= Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free=0A= * DString filled with UTF-8 name of file=0A= * causing error. */=0A= {=0A= int res =3D DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive,= =20=0A= errorPtr);=0A= =20=20=20=20=0A= if ((res =3D=3D TCL_ERROR) && (recursive !=3D 0) && (Tcl_GetErrno() =3D= =3D EEXIST)) {=0A= /*=0A= * The directory is nonempty, but the recursive flag has been=0A= * specified, so we recursively remove all the files in the directory.=0A= */=0A= return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);=0A= } else {=0A= return res;=0A= }=0A= }=0A= =0C=0A= /*=0A= *-------------------------------------------------------------------------= --=0A= *=0A= * TraverseWinTree --=0A= *=0A= * Traverse directory tree specified by sourcePtr, calling the functio= n=20=0A= * traverseProc for each file and directory encountered. If destPtr=20=0A= * is non-null, each of name in the sourcePtr directory is appended to=20= =0A= * the directory specified by destPtr and passed as the second argument=20= =0A= * to traverseProc() .=0A= *=0A= * Results:=0A= * Standard Tcl result.=0A= *=0A= * Side effects:=0A= * None caused by TraverseWinTree, however the user specified=20=0A= * traverseProc() may change state. If an error occurs, the error will=0A= * be returned immediately, and remaining files will not be processed.= =0A= *=0A= *-------------------------------------------------------------------------= --=0A= */=0A= =0A= static int=20=0A= TraverseWinTree(=0A= TraversalProc *traverseProc,/* Function to call for every file and=0A= * directory in source hierarchy. */=0A= Tcl_DString *sourcePtr, /* Pathname of source directory to be=0A= * traversed (native). */=0A= Tcl_DString *targetPtr, /* Pathname of directory to traverse in=0A= * parallel with source directory (native),=0A= * may be NULL. */=0A= Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free=0A= * DString filled with UTF-8 name of file=0A= * causing error. */=0A= {=0A= DWORD sourceAttr;=0A= TCHAR *nativeSource, *nativeTarget, *nativeErrfile;=0A= int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen;=0A= HANDLE handle;=0A= WIN32_FIND_DATAT data;=0A= =0A= nativeErrfile =3D NULL;=0A= result =3D TCL_OK;=0A= oldTargetLen =3D 0; /* lint. */=0A= =0A= nativeSource =3D (TCHAR *) Tcl_DStringValue(sourcePtr);=0A= nativeTarget =3D (TCHAR *) (targetPtr =3D=3D NULL ? NULL : Tcl_DStringV= alue(targetPtr));=0A= =20=20=20=20=0A= oldSourceLen =3D Tcl_DStringLength(sourcePtr);=0A= sourceAttr =3D (*tclWinProcs->getFileAttributesProc)(nativeSource);=0A= if (sourceAttr =3D=3D 0xffffffff) {=0A= nativeErrfile =3D nativeSource;=0A= goto end;=0A= }=0A= if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) =3D=3D 0) {=0A= /*=0A= * Process the regular file=0A= */=0A= =0A= return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr);=0A= }=0A= =0A= if (tclWinProcs->useWide) {=0A= Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);=0A= Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);=0A= } else {=0A= Tcl_DStringAppend(sourcePtr, "\\*.*", 4);=0A= }=0A= nativeSource =3D (TCHAR *) Tcl_DStringValue(sourcePtr);=0A= handle =3D (*tclWinProcs->findFirstFileProc)(nativeSource, &data);=0A= if (handle =3D=3D INVALID_HANDLE_VALUE) {=20=20=20=20=20=20=0A= /*=20=0A= * Can't read directory=0A= */=0A= =0A= TclWinConvertError(GetLastError());=0A= nativeErrfile =3D nativeSource;=0A= goto end;=0A= }=0A= =0A= nativeSource[oldSourceLen + 1] =3D '\0';=0A= Tcl_DStringSetLength(sourcePtr, oldSourceLen);=0A= result =3D (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, err= orPtr);=0A= if (result !=3D TCL_OK) {=0A= FindClose(handle);=0A= return result;=0A= }=0A= =0A= sourceLen =3D oldSourceLen;=0A= =0A= if (tclWinProcs->useWide) {=0A= sourceLen +=3D sizeof(WCHAR);=0A= Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);=0A= Tcl_DStringSetLength(sourcePtr, sourceLen);=0A= } else {=0A= sourceLen +=3D 1;=0A= Tcl_DStringAppend(sourcePtr, "\\", 1);=0A= }=0A= if (targetPtr !=3D NULL) {=0A= oldTargetLen =3D Tcl_DStringLength(targetPtr);=0A= =0A= targetLen =3D oldTargetLen;=0A= if (tclWinProcs->useWide) {=0A= targetLen +=3D sizeof(WCHAR);=0A= Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1);=0A= Tcl_DStringSetLength(targetPtr, targetLen);=0A= } else {=0A= targetLen +=3D 1;=0A= Tcl_DStringAppend(targetPtr, "\\", 1);=0A= }=0A= }=0A= =0A= found =3D 1;=0A= for ( ; found; found =3D (*tclWinProcs->findNextFileProc)(handle, &data= )) {=0A= TCHAR *nativeName;=0A= int len;=0A= =0A= if (tclWinProcs->useWide) {=0A= WCHAR *wp;=0A= =0A= wp =3D data.w.cFileName;=0A= if (*wp =3D=3D '.') {=0A= wp++;=0A= if (*wp =3D=3D '.') {=0A= wp++;=0A= }=0A= if (*wp =3D=3D '\0') {=0A= continue;=0A= }=0A= }=0A= nativeName =3D (TCHAR *) data.w.cFileName;=0A= len =3D Tcl_UniCharLen(data.w.cFileName) * sizeof(WCHAR);=0A= } else {=0A= if ((strcmp(data.a.cFileName, ".") =3D=3D 0)=20=0A= || (strcmp(data.a.cFileName, "..") =3D=3D 0)) {=0A= continue;=0A= }=0A= nativeName =3D (TCHAR *) data.a.cFileName;=0A= len =3D strlen(data.a.cFileName);=0A= }=0A= =0A= /*=20=0A= * Append name after slash, and recurse on the file.=20=0A= */=0A= =0A= Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1);=0A= Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);=0A= if (targetPtr !=3D NULL) {=0A= Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1);=0A= Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1);=0A= }=0A= result =3D TraverseWinTree(traverseProc, sourcePtr, targetPtr,=20=0A= errorPtr);=0A= if (result !=3D TCL_OK) {=0A= break;=0A= }=0A= =0A= /*=0A= * Remove name after slash.=0A= */=0A= =0A= Tcl_DStringSetLength(sourcePtr, sourceLen);=0A= if (targetPtr !=3D NULL) {=0A= Tcl_DStringSetLength(targetPtr, targetLen);=0A= }=0A= }=0A= FindClose(handle);=0A= =0A= /*=0A= * Strip off the trailing slash we added=0A= */=0A= =0A= Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);=0A= Tcl_DStringSetLength(sourcePtr, oldSourceLen);=0A= if (targetPtr !=3D NULL) {=0A= Tcl_DStringSetLength(targetPtr, oldTargetLen + 1);=0A= Tcl_DStringSetLength(targetPtr, oldTargetLen);=0A= }=0A= if (result =3D=3D TCL_OK) {=0A= /*=0A= * Call traverseProc() on a directory after visiting all the=0A= * files in that directory.=0A= */=0A= =0A= result =3D (*traverseProc)(Tcl_DStringValue(sourcePtr),=20=0A= (targetPtr =3D=3D NULL ? NULL : Tcl_DStringValue(targetPtr)),=20=0A= DOTREE_POSTD, errorPtr);=0A= }=0A= end:=0A= if (nativeErrfile !=3D NULL) {=0A= TclWinConvertError(GetLastError());=0A= if (errorPtr !=3D NULL) {=0A= Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr);=0A= }=0A= result =3D TCL_ERROR;=0A= }=0A= =09=20=20=20=20=0A= return result;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TraversalCopy=0A= *=0A= * Called from TraverseUnixTree in order to execute a recursive=0A= * copy of a directory.=0A= *=0A= * Results:=0A= * Standard Tcl result.=0A= *=0A= * Side effects:=0A= * Depending on the value of type, src may be copied to dst.=0A= *=20=20=20=20=20=20=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=20=0A= TraversalCopy(=0A= CONST TCHAR *nativeSrc, /* Source pathname to copy. */=0A= CONST TCHAR *nativeDst, /* Destination pathname of copy. */=0A= int type, /* Reason for call - see TraverseWinTree() */=0A= Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled=0A= * with UTF-8 name of file causing error. */=0A= {=0A= switch (type) {=0A= case DOTREE_F: {=0A= if (DoCopyFile(nativeSrc, nativeDst) =3D=3D TCL_OK) {=0A= return TCL_OK;=0A= }=0A= break;=0A= }=0A= case DOTREE_PRED: {=0A= if (DoCreateDirectory(nativeDst) =3D=3D TCL_OK) {=0A= DWORD attr =3D (*tclWinProcs->getFileAttributesProc)(nativeSrc);=0A= if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) !=3D FALSE) {= =0A= return TCL_OK;=0A= }=0A= TclWinConvertError(GetLastError());=0A= }=0A= break;=0A= }=0A= case DOTREE_POSTD: {=0A= return TCL_OK;=0A= }=0A= }=0A= =0A= /*=0A= * There shouldn't be a problem with src, because we already=0A= * checked it to get here.=0A= */=0A= =0A= if (errorPtr !=3D NULL) {=0A= Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);=0A= }=0A= return TCL_ERROR;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TraversalDelete --=0A= *=0A= * Called by procedure TraverseWinTree for every file and=0A= * directory that it encounters in a directory hierarchy. This=0A= * procedure unlinks files, and removes directories after all the=0A= * containing files have been processed.=0A= *=0A= * Results:=0A= * Standard Tcl result.=0A= *=0A= * Side effects:=0A= * Files or directory specified by src will be deleted. If an=0A= * error occurs, the windows error is converted to a Posix error=0A= * and errno is set accordingly.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= TraversalDelete(=20=0A= CONST TCHAR *nativeSrc, /* Source pathname to delete. */=0A= CONST TCHAR *dstPtr, /* Not used. */=0A= int type, /* Reason for call - see TraverseWinTree() */=0A= Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled=0A= * with UTF-8 name of file causing error. */=0A= {=0A= switch (type) {=0A= case DOTREE_F: {=0A= if (TclpDeleteFile(nativeSrc) =3D=3D TCL_OK) {=0A= return TCL_OK;=0A= }=0A= break;=0A= }=0A= case DOTREE_PRED: {=0A= return TCL_OK;=0A= }=0A= case DOTREE_POSTD: {=0A= if (DoRemoveJustDirectory(nativeSrc, 0, NULL) =3D=3D TCL_OK) {=0A= return TCL_OK;=0A= }=0A= break;=0A= }=0A= }=0A= =0A= if (errorPtr !=3D NULL) {=0A= Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);=0A= }=0A= return TCL_ERROR;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * StatError --=0A= *=0A= * Sets the object result with the appropriate error.=0A= *=0A= * Results:=0A= * None.=0A= *=0A= * Side effects:=0A= * The interp's object result is set with an error message=0A= * based on the objIndex, fileName and errno.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static void=0A= StatError(=0A= Tcl_Interp *interp, /* The interp that has the error */=0A= Tcl_Obj *fileName) /* The name of the file which caused the=20= =0A= * error. */=0A= {=0A= TclWinConvertError(GetLastError());=0A= Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),=20=0A= "could not read \"", Tcl_GetString(fileName),=20=0A= "\": ", Tcl_PosixError(interp),=20=0A= (char *) NULL);=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * GetWinFileAttributes --=0A= *=0A= * Returns a Tcl_Obj containing the value of a file attribute.=0A= * This routine gets the -hidden, -readonly or -system attribute.=0A= *=0A= * Results:=0A= * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object=0A= * will have ref count 0. If the return value is not TCL_OK,=0A= * attributePtrPtr is not touched.=0A= *=0A= * Side effects:=0A= * A new object is allocated if the file is valid.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= GetWinFileAttributes(=0A= Tcl_Interp *interp, /* The interp we are using for errors. */=0A= int objIndex, /* The index of the attribute. */=0A= Tcl_Obj *fileName, /* The name of the file. */=0A= Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */= =0A= {=0A= DWORD result;=0A= CONST TCHAR *nativeName;=0A= int attr;=0A= =20=20=20=20=0A= nativeName =3D Tcl_FSGetNativePath(fileName);=0A= result =3D (*tclWinProcs->getFileAttributesProc)(nativeName);=0A= =0A= if (result =3D=3D 0xffffffff) {=0A= StatError(interp, fileName);=0A= return TCL_ERROR;=0A= }=0A= =0A= attr =3D (int)(result & attributeArray[objIndex]);=0A= if ((objIndex =3D=3D WIN_HIDDEN_ATTRIBUTE) && (attr !=3D 0)) {=0A= /*=20=0A= * It is hidden. However there is a bug on some Windows=0A= * OSes in which root volumes (drives) formatted as NTFS=0A= * are declared hidden when they are not (and cannot be).=0A= *=20=0A= * We test for, and fix that case, here.=0A= */=0A= int len;=0A= char *str =3D Tcl_GetStringFromObj(fileName,&len);=0A= if (len < 4) {=0A= if (len =3D=3D 0) {=0A= /*=20=0A= * Not sure if this is possible, but we pass it on=0A= * anyway=20=0A= */=0A= } else if (len =3D=3D 1 && (str[0] =3D=3D '/' || str[0] =3D=3D '\\')) = {=0A= /* Path is pointing to the root volume */=0A= attr =3D 0;=0A= } else if ((str[1] =3D=3D ':')=20=0A= && (len =3D=3D 2 || (str[2] =3D=3D '/' || str[2] =3D=3D '\\'))) {= =0A= /* Path is of the form 'x:' or 'x:/' or 'x:\' */=0A= attr =3D 0;=0A= }=0A= }=0A= }=0A= *attributePtrPtr =3D Tcl_NewBooleanObj(attr);=0A= return TCL_OK;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * ConvertFileNameFormat --=0A= *=0A= * Returns a Tcl_Obj containing either the long or short version of th= e=20=0A= * file name.=0A= *=0A= * Results:=0A= * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object=0A= * will have ref count 0. If the return value is not TCL_OK,=0A= * attributePtrPtr is not touched.=0A= *=09=0A= * Warning: if you pass this function a drive name like 'c:' it=0A= * will actually return the current working directory on that=0A= * drive. To avoid this, make sure the drive name ends in a=0A= * slash, like this 'c:/'.=0A= *=0A= * Side effects:=0A= * A new object is allocated if the file is valid.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= ConvertFileNameFormat(=0A= Tcl_Interp *interp, /* The interp we are using for errors. */=0A= int objIndex, /* The index of the attribute. */=0A= Tcl_Obj *fileName, /* The name of the file. */=0A= int longShort, /* 0 to short name, 1 to long name. */=0A= Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */= =0A= {=0A= int pathc, i;=0A= Tcl_Obj *splitPath;=0A= int result =3D TCL_OK;=0A= =0A= splitPath =3D Tcl_FSSplitPath(fileName, &pathc);=0A= =0A= if (splitPath =3D=3D NULL || pathc =3D=3D 0) {=0A= if (interp !=3D NULL) {=0A= Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),=20=0A= "could not read \"", Tcl_GetString(fileName),=0A= "\": no such file or directory",=20=0A= (char *) NULL);=0A= }=0A= result =3D TCL_ERROR;=0A= goto cleanup;=0A= }=0A= =20=20=20=20=0A= for (i =3D 0; i < pathc; i++) {=0A= Tcl_Obj *elt;=0A= char *pathv;=0A= int pathLen;=0A= Tcl_ListObjIndex(NULL, splitPath, i, &elt);=0A= =09=0A= pathv =3D Tcl_GetStringFromObj(elt, &pathLen);=0A= if ((pathv[0] =3D=3D '/')=0A= || ((pathLen =3D=3D 3) && (pathv[1] =3D=3D ':'))=0A= || (strcmp(pathv, ".") =3D=3D 0)=0A= || (strcmp(pathv, "..") =3D=3D 0)) {=0A= /*=0A= * Handle "/", "//machine/export", "c:/", "." or ".." by just=0A= * copying the string literally. Uppercase the drive letter,=0A= * just because it looks better under Windows to do so.=0A= */=0A= =0A= simple:=0A= /* Here we are modifying the string representation in place */=0A= /* I believe this is legal, since this won't affect any=20=0A= * file representation this thing may have. */=0A= pathv[0] =3D (char) Tcl_UniCharToUpper(UCHAR(pathv[0]));=0A= } else {=0A= Tcl_Obj *tempPath;=0A= Tcl_DString ds;=0A= Tcl_DString dsTemp;=0A= TCHAR *nativeName;=0A= char *tempString;=0A= int tempLen;=0A= WIN32_FIND_DATAT data;=0A= HANDLE handle;=0A= DWORD attr;=0A= =0A= tempPath =3D Tcl_FSJoinPath(splitPath, i+1);=0A= Tcl_IncrRefCount(tempPath);=0A= /*=20=0A= * We'd like to call Tcl_FSGetNativePath(tempPath)=0A= * but that is likely to lead to infinite loops=20=0A= */=0A= Tcl_DStringInit(&ds);=0A= tempString =3D Tcl_GetStringFromObj(tempPath,&tempLen);=0A= nativeName =3D Tcl_WinUtfToTChar(tempString, tempLen, &ds);=0A= Tcl_DecrRefCount(tempPath);=0A= handle =3D (*tclWinProcs->findFirstFileProc)(nativeName, &data);=0A= if (handle =3D=3D INVALID_HANDLE_VALUE) {=0A= /*=0A= * FindFirstFile() doesn't like root directories. We=20=0A= * would only get a root directory here if the caller=0A= * specified "c:" or "c:." and the current directory on the=0A= * drive was the root directory=0A= */=0A= =0A= attr =3D (*tclWinProcs->getFileAttributesProc)(nativeName);=0A= if ((attr !=3D 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {=0A= Tcl_DStringFree(&ds);=0A= goto simple;=0A= }=0A= }=0A= =0A= if (handle =3D=3D INVALID_HANDLE_VALUE) {=0A= Tcl_DStringFree(&ds);=0A= if (interp !=3D NULL) {=0A= StatError(interp, fileName);=0A= }=0A= result =3D TCL_ERROR;=0A= goto cleanup;=0A= }=0A= if (tclWinProcs->useWide) {=0A= nativeName =3D (TCHAR *) data.w.cAlternateFileName;=0A= if (longShort) {=0A= if (data.w.cFileName[0] !=3D '\0') {=0A= nativeName =3D (TCHAR *) data.w.cFileName;=0A= }=20=0A= } else {=0A= if (data.w.cAlternateFileName[0] =3D=3D '\0') {=0A= nativeName =3D (TCHAR *) data.w.cFileName;=0A= }=0A= }=0A= } else {=0A= nativeName =3D (TCHAR *) data.a.cAlternateFileName;=0A= if (longShort) {=0A= if (data.a.cFileName[0] !=3D '\0') {=0A= nativeName =3D (TCHAR *) data.a.cFileName;=0A= }=20=0A= } else {=0A= if (data.a.cAlternateFileName[0] =3D=3D '\0') {=0A= nativeName =3D (TCHAR *) data.a.cFileName;=0A= }=0A= }=0A= }=0A= =0A= /*=0A= * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying=20=0A= * to dereference nativeName as a Unicode string. I have proven=20=0A= * to myself that purify is wrong by running the following=20=0A= * example when nativeName =3D=3D data.w.cAlternateFileName and=20=0A= * noting that purify doesn't complain about the first line,=0A= * but does complain about the second.=0A= *=0A= * fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);=0A= * fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);=0A= */=0A= =0A= Tcl_DStringInit(&dsTemp);=0A= Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);=0A= /* Deal with issues of tildes being absolute */=0A= if (Tcl_DStringValue(&dsTemp)[0] =3D=3D '~') {=0A= tempPath =3D Tcl_NewStringObj("./",2);=0A= Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),=20=0A= Tcl_DStringLength(&dsTemp));=0A= } else {=0A= tempPath =3D Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),=20=0A= Tcl_DStringLength(&dsTemp));=0A= }=0A= Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);=0A= Tcl_DStringFree(&ds);=0A= Tcl_DStringFree(&dsTemp);=0A= FindClose(handle);=0A= }=0A= }=0A= =0A= *attributePtrPtr =3D Tcl_FSJoinPath(splitPath, -1);=0A= =0A= cleanup:=0A= if (splitPath !=3D NULL) {=0A= Tcl_DecrRefCount(splitPath);=0A= }=0A= =20=20=0A= return result;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * GetWinFileLongName --=0A= *=0A= * Returns a Tcl_Obj containing the long version of the file=0A= * name.=0A= *=0A= * Results:=0A= * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object=0A= * will have ref count 0. If the return value is not TCL_OK,=0A= * attributePtrPtr is not touched.=0A= *=0A= * Side effects:=0A= * A new object is allocated if the file is valid.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= GetWinFileLongName(=0A= Tcl_Interp *interp, /* The interp we are using for errors. */=0A= int objIndex, /* The index of the attribute. */=0A= Tcl_Obj *fileName, /* The name of the file. */=0A= Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */= =0A= {=0A= return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePt= rPtr);=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * GetWinFileShortName --=0A= *=0A= * Returns a Tcl_Obj containing the short version of the file=0A= * name.=0A= *=0A= * Results:=0A= * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object=0A= * will have ref count 0. If the return value is not TCL_OK,=0A= * attributePtrPtr is not touched.=0A= *=0A= * Side effects:=0A= * A new object is allocated if the file is valid.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= GetWinFileShortName(=0A= Tcl_Interp *interp, /* The interp we are using for errors. */=0A= int objIndex, /* The index of the attribute. */=0A= Tcl_Obj *fileName, /* The name of the file. */=0A= Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */= =0A= {=0A= return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePt= rPtr);=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * SetWinFileAttributes --=0A= *=0A= * Set the file attributes to the value given by attributePtr.=0A= * This routine sets the -hidden, -readonly, or -system attributes.=0A= *=0A= * Results:=0A= * Standard TCL error.=0A= *=0A= * Side effects:=0A= * The file's attribute is set.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= SetWinFileAttributes(=0A= Tcl_Interp *interp, /* The interp we are using for errors. */=0A= int objIndex, /* The index of the attribute. */=0A= Tcl_Obj *fileName, /* The name of the file. */=0A= Tcl_Obj *attributePtr) /* The new value of the attribute. */=0A= {=0A= DWORD fileAttributes;=0A= int yesNo;=0A= int result;=0A= CONST TCHAR *nativeName;=0A= =0A= nativeName =3D Tcl_FSGetNativePath(fileName);=0A= fileAttributes =3D (*tclWinProcs->getFileAttributesProc)(nativeName);= =0A= =0A= if (fileAttributes =3D=3D 0xffffffff) {=0A= StatError(interp, fileName);=0A= return TCL_ERROR;=0A= }=0A= =0A= result =3D Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);=0A= if (result !=3D TCL_OK) {=0A= return result;=0A= }=0A= =0A= if (yesNo) {=0A= fileAttributes |=3D (attributeArray[objIndex]);=0A= } else {=0A= fileAttributes &=3D ~(attributeArray[objIndex]);=0A= }=0A= =0A= if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes))= {=0A= StatError(interp, fileName);=0A= return TCL_ERROR;=0A= }=0A= =0A= return result;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * SetWinFileLongName --=0A= *=0A= * The attribute in question is a readonly attribute and cannot=0A= * be set.=0A= *=0A= * Results:=0A= * TCL_ERROR=0A= *=0A= * Side effects:=0A= * The object result is set to a pertinent error message.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= CannotSetAttribute(=0A= Tcl_Interp *interp, /* The interp we are using for errors. */=0A= int objIndex, /* The index of the attribute. */=0A= Tcl_Obj *fileName, /* The name of the file. */=0A= Tcl_Obj *attributePtr) /* The new value of the attribute. */=0A= {=0A= Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),=20=0A= "cannot set attribute \"", tclpFileAttrStrings[objIndex],=0A= "\" for file \"", Tcl_GetString(fileName),=20=0A= "\": attribute is readonly",=20=0A= (char *) NULL);=0A= return TCL_ERROR;=0A= }=0A= =0A= =0C=0A= /*=0A= *-------------------------------------------------------------------------= --=0A= *=0A= * TclpObjListVolumes --=0A= *=0A= * Lists the currently mounted volumes=0A= *=0A= * Results:=0A= * The list of volumes.=0A= *=0A= * Side effects:=0A= * None=0A= *=0A= *-------------------------------------------------------------------------= --=0A= */=0A= =0A= Tcl_Obj*=0A= TclpObjListVolumes(void)=0A= {=0A= Tcl_Obj *resultPtr, *elemPtr;=0A= char buf[40 * 4]; /* There couldn't be more than 30 drives??? */=0A= int i;=0A= char *p;=0A= =0A= resultPtr =3D Tcl_NewObj();=0A= =0A= /*=0A= * On Win32s:=0A= * GetLogicalDriveStrings() isn't implemented.=0A= * GetLogicalDrives() returns incorrect information.=0A= */=0A= =0A= if (GetLogicalDriveStringsA(sizeof(buf), buf) =3D=3D 0) {=0A= /*=0A= * GetVolumeInformation() will detects all drives, but causes=0A= * chattering on empty floppy drives. We only do this if=20=0A= * GetLogicalDriveStrings() didn't work. It has also been reported=0A= * that on some laptops it takes a while for GetVolumeInformation()=0A= * to return when pinging an empty floppy drive, another reason to=20=0A= * try to avoid calling it.=0A= */=0A= =0A= buf[1] =3D ':';=0A= buf[2] =3D '/';=0A= buf[3] =3D '\0';=0A= =0A= for (i =3D 0; i < 26; i++) {=0A= buf[0] =3D (char) ('a' + i);=0A= if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)=20= =20=0A= || (GetLastError() =3D=3D ERROR_NOT_READY)) {=0A= elemPtr =3D Tcl_NewStringObj(buf, -1);=0A= Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);=0A= }=0A= }=0A= } else {=0A= for (p =3D buf; *p !=3D '\0'; p +=3D 4) {=0A= p[2] =3D '/';=0A= elemPtr =3D Tcl_NewStringObj(p, -1);=0A= Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);=0A= }=0A= }=0A= =20=20=20=20=0A= Tcl_IncrRefCount(resultPtr);=0A= return resultPtr;=0A= }=0A= ------=_NextPart_000_0003_01C607DB.40902AA0 Content-Type: application/octet-stream; name="tclWin32Dll.c" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="tclWin32Dll.c" Content-length: 19910 /* used attribute added on line 396 - pir (23.12.2005) */=0A= =0A= /*=20=0A= * tclWin32Dll.c --=0A= *=0A= * This file contains the DLL entry point.=0A= *=0A= * Copyright (c) 1995-1996 Sun Microsystems, Inc.=0A= * Copyright (c) 1998-2000 Scriptics Corporation.=0A= *=0A= * See the file "license.terms" for information on usage and redistribution= =0A= * of this file, and for a DISCLAIMER OF ALL WARRANTIES.=0A= *=0A= * RCS: @(#) $Id: tclWin32Dll.c,v 1.16 2002/06/13 09:40:01 vincentdarley Ex= p $=0A= */=0A= =0A= #include "tclWinInt.h"=0A= =0A= /*=0A= * The following data structures are used when loading the thunking=20=0A= * library for execing child processes under Win32s.=0A= */=0A= =0A= typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,=0A= LPVOID *lpTranslationList);=0A= =0A= typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,=0A= LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,=0A= FARPROC UT32Callback, LPVOID Buff);=0A= =0A= typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);=0A= =0A= /*=20=0A= * The following variables keep track of information about this DLL=0A= * on a per-instance basis. Each time this DLL is loaded, it gets its own= =20=0A= * new data segment with its own copy of all static and global information.= =0A= */=0A= =0A= static HINSTANCE hInstance; /* HINSTANCE of this DLL. */=0A= static int platformId; /* Running under NT, or 95/98? */=0A= =0A= #ifdef HAVE_NO_SEH=0A= static void *ESP;=0A= static void *EBP;=0A= #endif /* HAVE_NO_SEH */=0A= =0A= /*=0A= * The following function tables are used to dispatch to either the=0A= * wide-character or multi-byte versions of the operating system calls,=0A= * depending on whether the Unicode calls are available.=0A= */=0A= =0A= static TclWinProcs asciiProcs =3D {=0A= 0,=0A= =0A= (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA,=0A= (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA,=0A= (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA,=0A= (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectory= A,=0A= (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,= =20=0A= DWORD, DWORD, HANDLE)) CreateFileA,=0A= (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,=20=0A= LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,=20=0A= LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,=0A= (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA,=0A= (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA,= =0A= (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA,=0A= (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA,=0A= (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA,=0A= (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,=0A= (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,=20=0A= TCHAR **)) GetFullPathNameA,=0A= (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA,=0A= (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA,=0A= (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,=20=0A= WCHAR *)) GetTempFileNameA,=0A= (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA,=0A= (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWO= RD,=0A= WCHAR *, DWORD)) GetVolumeInformationA,=0A= (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryA,=0A= (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA,=0A= (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA,=0A= (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA,=0A= (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,= =20=0A= WCHAR *, TCHAR **)) SearchPathA,=0A= (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,=0A= (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,=0A= NULL,=0A= NULL,=0A= };=0A= =0A= static TclWinProcs unicodeProcs =3D {=0A= 1,=0A= =0A= (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW,=0A= (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW,=0A= (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW,=0A= (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectory= W,=0A= (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,= =20=0A= DWORD, DWORD, HANDLE)) CreateFileW,=0A= (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,=20=0A= LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,=20=0A= LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,=0A= (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW,=0A= (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW,= =0A= (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW,=0A= (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW,=0A= (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW,=0A= (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,=0A= (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,=20=0A= TCHAR **)) GetFullPathNameW,=0A= (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW,=0A= (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW,=0A= (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,=20=0A= WCHAR *)) GetTempFileNameW,=0A= (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW,=0A= (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWO= RD,=20=0A= WCHAR *, DWORD)) GetVolumeInformationW,=0A= (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryW,=0A= (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW,=0A= (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW,=0A= (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW,=0A= (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,= =20=0A= WCHAR *, TCHAR **)) SearchPathW,=0A= (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,=0A= (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,=0A= NULL,=0A= NULL,=0A= };=0A= =0A= TclWinProcs *tclWinProcs;=0A= static Tcl_Encoding tclWinTCharEncoding;=0A= =0A= /*=0A= * The following declaration is for the VC++ DLL entry point.=0A= */=0A= =0A= BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,=20=0A= LPVOID reserved);=0A= =0A= =0A= #ifdef __WIN32__=0A= #ifndef STATIC_BUILD=0A= =0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * DllEntryPoint --=0A= *=0A= * This wrapper function is used by Borland to invoke the=0A= * initialization code for Tcl. It simply calls the DllMain=0A= * routine.=0A= *=0A= * Results:=0A= * See DllMain.=0A= *=0A= * Side effects:=0A= * See DllMain.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= BOOL APIENTRY=0A= DllEntryPoint(hInst, reason, reserved)=0A= HINSTANCE hInst; /* Library instance handle. */=0A= DWORD reason; /* Reason this function is being called. */=0A= LPVOID reserved; /* Not used. */=0A= {=0A= return DllMain(hInst, reason, reserved);=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * DllMain --=0A= *=0A= * This routine is called by the VC++ C run time library init=0A= * code, or the DllEntryPoint routine. It is responsible for=0A= * initializing various dynamically loaded libraries.=0A= *=0A= * Results:=0A= * TRUE on sucess, FALSE on failure.=0A= *=0A= * Side effects:=0A= * Establishes 32-to-16 bit thunk and initializes sockets library.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= BOOL APIENTRY=0A= DllMain(hInst, reason, reserved)=0A= HINSTANCE hInst; /* Library instance handle. */=0A= DWORD reason; /* Reason this function is being called. */=0A= LPVOID reserved; /* Not used. */=0A= {=0A= switch (reason) {=0A= case DLL_PROCESS_ATTACH:=0A= TclWinInit(hInst);=0A= return TRUE;=0A= =0A= case DLL_PROCESS_DETACH:=0A= if (hInst =3D=3D hInstance) {=0A= Tcl_Finalize();=0A= }=0A= break;=0A= }=0A= =0A= return TRUE;=20=0A= }=0A= =0A= #endif /* !STATIC_BUILD */=0A= #endif /* __WIN32__ */=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TclWinGetTclInstance --=0A= *=0A= * Retrieves the global library instance handle.=0A= *=0A= * Results:=0A= * Returns the global library instance handle.=0A= *=0A= * Side effects:=0A= * None.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= HINSTANCE=0A= TclWinGetTclInstance()=0A= {=0A= return hInstance;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TclWinInit --=0A= *=0A= * This function initializes the internal state of the tcl library.=0A= *=0A= * Results:=0A= * None.=0A= *=0A= * Side effects:=0A= * Initializes the tclPlatformId variable.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= void=0A= TclWinInit(hInst)=0A= HINSTANCE hInst; /* Library instance handle. */=0A= {=0A= OSVERSIONINFO os;=0A= =0A= hInstance =3D hInst;=0A= os.dwOSVersionInfoSize =3D sizeof(OSVERSIONINFO);=0A= GetVersionEx(&os);=0A= platformId =3D os.dwPlatformId;=0A= =0A= /*=0A= * We no longer support Win32s, so just in case someone manages to=0A= * get a runtime there, make sure they know that.=0A= */=0A= =0A= if (platformId =3D=3D VER_PLATFORM_WIN32s) {=0A= panic("Win32s is not a supported platform");=09=0A= }=0A= =0A= tclWinProcs =3D &asciiProcs;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TclWinGetPlatformId --=0A= *=0A= * Determines whether running under NT, 95, or Win32s, to allow=20=0A= * runtime conditional code.=0A= *=0A= * Results:=0A= * The return value is one of:=0A= * VER_PLATFORM_WIN32s Win32s on Windows 3.1. (not supported)=0A= * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95.=0A= * VER_PLATFORM_WIN32_NT Win32 on Windows NT=0A= *=0A= * Side effects:=0A= * None.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= int=09=09=0A= TclWinGetPlatformId()=0A= {=0A= return platformId;=0A= }=0A= =0C=0A= /*=0A= *-------------------------------------------------------------------------= =0A= *=0A= * TclWinNoBackslash --=0A= *=0A= * We're always iterating through a string in Windows, changing the=0A= * backslashes to slashes for use in Tcl.=0A= *=0A= * Results:=0A= * All backslashes in given string are changed to slashes.=0A= *=0A= * Side effects:=0A= * None.=0A= *=0A= *-------------------------------------------------------------------------= =0A= */=0A= =0A= char *=0A= TclWinNoBackslash(=0A= char *path) /* String to change. */=0A= {=0A= char *p;=0A= =0A= for (p =3D path; *p !=3D '\0'; p++) {=0A= if (*p =3D=3D '\\') {=0A= *p =3D '/';=0A= }=0A= }=0A= return path;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TclpCheckStackSpace --=0A= *=0A= * Detect if we are about to blow the stack. Called before an=20=0A= * evaluation can happen when nesting depth is checked.=0A= *=0A= * Results:=0A= * 1 if there is enough stack space to continue; 0 if not.=0A= *=0A= * Side effects:=0A= * None.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= int=0A= TclpCheckStackSpace()=0A= {=0A= int retval =3D 0;=0A= =0A= /*=0A= * We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD=0A= * bytes of stack space left. alloca() is cheap on windows; basically= =0A= * it just subtracts from the stack pointer causing the OS to throw an= =0A= * exception if the stack pointer is set below the bottom of the stack.= =0A= */=0A= =0A= #ifdef HAVE_NO_SEH=0A= __asm__ __volatile__ (=0A= "movl %esp, _ESP" "\n\t"=0A= "movl %ebp, _EBP");=0A= =0A= __asm__ __volatile__ (=0A= "pushl $__except_checkstackspace_handler" "\n\t"=0A= "pushl %fs:0" "\n\t"=0A= "mov %esp, %fs:0");=0A= #else=0A= __try {=0A= #endif /* HAVE_NO_SEH */=0A= alloca(TCL_WIN_STACK_THRESHOLD);=0A= retval =3D 1;=0A= #ifdef HAVE_NO_SEH=0A= __asm__ __volatile__ (=0A= "jmp checkstackspace_pop" "\n"=0A= "checkstackspace_reentry:" "\n\t"=0A= "movl _ESP, %esp" "\n\t"=0A= "movl _EBP, %ebp");=0A= =0A= __asm__ __volatile__ (=0A= "checkstackspace_pop:" "\n\t"=0A= "mov (%esp), %eax" "\n\t"=0A= "mov %eax, %fs:0" "\n\t"=0A= "add $8, %esp");=0A= #else=0A= } __except (EXCEPTION_EXECUTE_HANDLER) {}=0A= #endif /* HAVE_NO_SEH */=0A= =0A= /*=0A= * Avoid using control flow statements in the SEH guarded block!=0A= */=0A= return retval;=0A= }=0A= #ifdef HAVE_NO_SEH=0A= static=0A= __attribute__ ((used, /* pir - 23.12.2005 */cdecl))=0A= EXCEPTION_DISPOSITION=0A= _except_checkstackspace_handler(=0A= struct _EXCEPTION_RECORD *ExceptionRecord,=0A= void *EstablisherFrame,=0A= struct _CONTEXT *ContextRecord,=0A= void *DispatcherContext)=0A= {=0A= __asm__ __volatile__ (=0A= "jmp checkstackspace_reentry");=0A= return 0; /* Function does not return */=0A= }=0A= #endif /* HAVE_NO_SEH */=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TclWinGetPlatform --=0A= *=0A= * This is a kludge that allows the test library to get access=0A= * the internal tclPlatform variable.=0A= *=0A= * Results:=0A= * Returns a pointer to the tclPlatform variable.=0A= *=0A= * Side effects:=0A= * None.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= TclPlatformType *=0A= TclWinGetPlatform()=0A= {=0A= return &tclPlatform;=0A= }=0A= =0C=0A= /*=0A= *-------------------------------------------------------------------------= --=0A= *=0A= * TclWinSetInterfaces --=0A= *=0A= * A helper proc that allows the test library to change the=0A= * tclWinProcs structure to dispatch to either the wide-character=0A= * or multi-byte versions of the operating system calls, depending=0A= * on whether Unicode is the system encoding.=0A= *=09=0A= * As well as this, we can also try to load in some additional=0A= * procs which may/may not be present depending on the current=0A= * Windows version (e.g. Win95 will not have the procs below).=0A= *=0A= * Results:=0A= * None.=0A= *=0A= * Side effects:=0A= * None.=0A= *=0A= *-------------------------------------------------------------------------= --=0A= */=0A= =0A= void=0A= TclWinSetInterfaces(=0A= int wide) /* Non-zero to use wide interfaces, 0=0A= * otherwise. */=0A= {=0A= Tcl_FreeEncoding(tclWinTCharEncoding);=0A= =0A= if (wide) {=0A= tclWinProcs =3D &unicodeProcs;=0A= tclWinTCharEncoding =3D Tcl_GetEncoding(NULL, "unicode");=0A= if (tclWinProcs->getFileAttributesExProc =3D=3D NULL) {=0A= HINSTANCE hInstance =3D LoadLibraryA("kernel32");=0A= if (hInstance !=3D NULL) {=0A= tclWinProcs->getFileAttributesExProc =3D=20=0A= (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,=20=0A= LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExW");=0A= tclWinProcs->createHardLinkProc =3D=20=0A= (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,=20=0A= LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,=20=0A= "CreateHardLinkW");=0A= FreeLibrary(hInstance);=0A= }=0A= }=0A= } else {=0A= tclWinProcs =3D &asciiProcs;=0A= tclWinTCharEncoding =3D NULL;=0A= if (tclWinProcs->getFileAttributesExProc =3D=3D NULL) {=0A= HINSTANCE hInstance =3D LoadLibraryA("kernel32");=0A= if (hInstance !=3D NULL) {=0A= tclWinProcs->getFileAttributesExProc =3D=20=0A= (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,=20=0A= LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExA");=0A= tclWinProcs->createHardLinkProc =3D=20=0A= (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,=20=0A= LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,=20=0A= "CreateHardLinkA");=0A= FreeLibrary(hInstance);=0A= }=0A= }=0A= }=0A= }=0A= =0C=0A= /*=0A= *-------------------------------------------------------------------------= --=0A= *=0A= * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --=0A= *=0A= * Convert between UTF-8 and Unicode when running Windows NT or=20=0A= * the current ANSI code page when running Windows 95.=0A= *=0A= * On Mac, Unix, and Windows 95, all strings exchanged between Tcl=0A= * and the OS are "char" oriented. We need only one Tcl_Encoding to=0A= * convert between UTF-8 and the system's native encoding. We use=0A= * NULL to represent that encoding.=0A= *=0A= * On NT, some strings exchanged between Tcl and the OS are "char"=0A= * oriented, while others are in Unicode. We need two Tcl_Encoding=0A= * APIs depending on whether we are targeting a "char" or Unicode=0A= * interface.=20=20=0A= *=0A= * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an=0A= * encoding of NULL should always used to convert between UTF-8=0A= * and the system's "char" oriented encoding. The following two=0A= * functions are used in Windows-specific code to convert between=0A= * UTF-8 and Unicode strings (NT) or "char" strings(95). This saves=0A= * you the trouble of writing the following type of fragment over and=0A= * over:=0A= *=0A= * if (running NT) {=0A= * encoding <- Tcl_GetEncoding("unicode");=0A= * nativeBuffer <- UtfToExternal(encoding, utfBuffer);=0A= * Tcl_FreeEncoding(encoding);=0A= * } else {=0A= * nativeBuffer <- UtfToExternal(NULL, utfBuffer);=0A= * }=0A= *=0A= * By convention, in Windows a TCHAR is a character in the ANSI code=0A= * page on Windows 95, a Unicode character on Windows NT. If you=0A= * plan on targeting a Unicode interfaces when running on NT and a=0A= * "char" oriented interface while running on 95, these functions=0A= * should be used. If you plan on targetting the same "char"=0A= * oriented function on both 95 and NT, use Tcl_UtfToExternal()=0A= * with an encoding of NULL.=0A= *=0A= * Results:=0A= * The result is a pointer to the string in the desired target=0A= * encoding. Storage for the result string is allocated in=0A= * dsPtr; the caller must call Tcl_DStringFree() when the result=0A= * is no longer needed.=0A= *=0A= * Side effects:=0A= * None.=0A= *=0A= *-------------------------------------------------------------------------= --=0A= */=0A= =0A= TCHAR *=0A= Tcl_WinUtfToTChar(string, len, dsPtr)=0A= CONST char *string; /* Source string in UTF-8. */=0A= int len; /* Source string length in bytes, or < 0 for=0A= * strlen(). */=0A= Tcl_DString *dsPtr; /* Uninitialized or free DString in which=20=0A= * the converted string is stored. */=0A= {=0A= return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,=20=0A= string, len, dsPtr);=0A= }=0A= =0A= char *=0A= Tcl_WinTCharToUtf(string, len, dsPtr)=0A= CONST TCHAR *string; /* Source string in Unicode when running=0A= * NT, ANSI when running 95. */=0A= int len; /* Source string length in bytes, or < 0 for=0A= * platform-specific string length. */=0A= Tcl_DString *dsPtr; /* Uninitialized or free DString in which=20=0A= * the converted string is stored. */=0A= {=0A= return Tcl_ExternalToUtfDString(tclWinTCharEncoding,=20=0A= (CONST char *) string, len, dsPtr);=0A= }=0A= ------=_NextPart_000_0003_01C607DB.40902AA0 Content-Type: application/octet-stream; name="tclWinChan.c" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="tclWinChan.c" Content-length: 41394 /* used attribute added on line 1109 - pir (23.12.2005) */=0A= =0A= /*=20=0A= * tclWinChan.c=0A= *=0A= * Channel drivers for Windows channels based on files, command=0A= * pipes and TCP sockets.=0A= *=0A= * Copyright (c) 1995-1997 Sun Microsystems, Inc.=0A= *=0A= * See the file "license.terms" for information on usage and redistribution= =0A= * of this file, and for a DISCLAIMER OF ALL WARRANTIES.=0A= *=0A= * RCS: @(#) $Id: tclWinChan.c,v 1.24 2002/07/08 10:08:58 vincentdarley Exp= $=0A= */=0A= =0A= #include "tclWinInt.h"=0A= =0A= /*=0A= * State flags used in the info structures below.=0A= */=0A= =0A= #define FILE_PENDING (1<<0) /* Message is pending in the queue. */=0A= #define FILE_ASYNC (1<<1) /* Channel is non-blocking. */=0A= #define FILE_APPEND (1<<2) /* File is in append mode. */=0A= =0A= #define FILE_TYPE_SERIAL (FILE_TYPE_PIPE+1)=0A= #define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)=0A= =0A= /*=0A= * The following structure contains per-instance data for a file based chan= nel.=0A= */=0A= =0A= typedef struct FileInfo {=0A= Tcl_Channel channel; /* Pointer to channel structure. */=0A= int validMask; /* OR'ed combination of TCL_READABLE,=0A= * TCL_WRITABLE, or TCL_EXCEPTION: indicates=0A= * which operations are valid on the file. */=0A= int watchMask; /* OR'ed combination of TCL_READABLE,=0A= * TCL_WRITABLE, or TCL_EXCEPTION: indicates=0A= * which events should be reported. */=0A= int flags; /* State flags, see above for a list. */=0A= HANDLE handle; /* Input/output file. */=0A= struct FileInfo *nextPtr; /* Pointer to next registered file. */=0A= int dirty; /* Boolean flag. Set if the OS may have dat= a=0A= * pending on the channel */=0A= } FileInfo;=0A= =0A= typedef struct ThreadSpecificData {=0A= /*=0A= * List of all file channels currently open.=0A= */=0A= =0A= FileInfo *firstFilePtr;=0A= } ThreadSpecificData;=0A= =0A= static Tcl_ThreadDataKey dataKey;=0A= =0A= /*=0A= * The following structure is what is added to the Tcl event queue when=0A= * file events are generated.=0A= */=0A= =0A= typedef struct FileEvent {=0A= Tcl_Event header; /* Information that is standard for=0A= * all events. */=0A= FileInfo *infoPtr; /* Pointer to file info structure. Note=0A= * that we still have to verify that the=0A= * file exists before dereferencing this=0A= * pointer. */=0A= } FileEvent;=0A= =0A= /*=0A= * Static routines for this file:=0A= */=0A= =0A= static int FileBlockProc _ANSI_ARGS_((ClientData instanceData,=0A= int mode));=0A= static void FileChannelExitHandler _ANSI_ARGS_((=0A= ClientData clientData));=0A= static void FileCheckProc _ANSI_ARGS_((ClientData clientData,=0A= int flags));=0A= static int FileCloseProc _ANSI_ARGS_((ClientData instanceData,=0A= Tcl_Interp *interp));=0A= static int FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,=20=0A= int flags));=0A= static int FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,=0A= int direction, ClientData *handlePtr));=0A= static ThreadSpecificData *FileInit _ANSI_ARGS_((void));=0A= static int FileInputProc _ANSI_ARGS_((ClientData instanceData,=0A= char *buf, int toRead, int *errorCode));=0A= static int FileOutputProc _ANSI_ARGS_((ClientData instanceData,=0A= CONST char *buf, int toWrite, int *errorCode));=0A= static int FileSeekProc _ANSI_ARGS_((ClientData instanceData,=0A= long offset, int mode, int *errorCode));=0A= static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,= =0A= Tcl_WideInt offset, int mode, int *errorCode));=0A= static void FileSetupProc _ANSI_ARGS_((ClientData clientData,=0A= int flags));=0A= static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,=0A= int mask));=0A= =0A= =09=09=09=20=20=20=20=0A= /*=0A= * This structure describes the channel type structure for file based IO.= =0A= */=0A= =0A= static Tcl_ChannelType fileChannelType =3D {=0A= "file", /* Type name. */=0A= TCL_CHANNEL_VERSION_3, /* v3 channel */=0A= FileCloseProc, /* Close proc. */=0A= FileInputProc, /* Input proc. */=0A= FileOutputProc, /* Output proc. */=0A= FileSeekProc, /* Seek proc. */=0A= NULL, /* Set option proc. */=0A= NULL, /* Get option proc. */=0A= FileWatchProc, /* Set up the notifier to watch the channel. */=0A= FileGetHandleProc, /* Get an OS handle from channel. */=0A= NULL, /* close2proc. */=0A= FileBlockProc, /* Set blocking or non-blocking mode.*/=0A= NULL, /* flush proc. */=0A= NULL, /* handler proc. */=0A= FileWideSeekProc, /* Wide seek proc. */=0A= };=0A= =0A= #ifdef HAVE_NO_SEH=0A= static void *ESP;=0A= static void *EBP;=0A= #endif /* HAVE_NO_SEH */=0A= =0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileInit --=0A= *=0A= * This function creates the window used to simulate file events.=0A= *=0A= * Results:=0A= * None.=0A= *=0A= * Side effects:=0A= * Creates a new window and creates an exit handler.=20=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static ThreadSpecificData *=0A= FileInit()=0A= {=0A= ThreadSpecificData *tsdPtr =3D=0A= (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);=0A= if (tsdPtr =3D=3D NULL) {=0A= tsdPtr =3D TCL_TSD_INIT(&dataKey);=0A= tsdPtr->firstFilePtr =3D NULL;=0A= Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);=0A= Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);=0A= }=0A= return tsdPtr;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileChannelExitHandler --=0A= *=0A= * This function is called to cleanup the channel driver before=0A= * Tcl is unloaded.=0A= *=0A= * Results:=0A= * None.=0A= *=0A= * Side effects:=0A= * Destroys the communication window.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static void=0A= FileChannelExitHandler(clientData)=0A= ClientData clientData; /* Old window proc */=0A= {=0A= Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileSetupProc --=0A= *=0A= * This procedure is invoked before Tcl_DoOneEvent blocks waiting=0A= * for an event.=0A= *=0A= * Results:=0A= * None.=0A= *=0A= * Side effects:=0A= * Adjusts the block time if needed.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= void=0A= FileSetupProc(data, flags)=0A= ClientData data; /* Not used. */=0A= int flags; /* Event flags as passed to Tcl_DoOneEvent. */=0A= {=0A= FileInfo *infoPtr;=0A= Tcl_Time blockTime =3D { 0, 0 };=0A= ThreadSpecificData *tsdPtr =3D TCL_TSD_INIT(&dataKey);=0A= =0A= if (!(flags & TCL_FILE_EVENTS)) {=0A= return;=0A= }=0A= =20=20=20=20=0A= /*=0A= * Check to see if there is a ready file. If so, poll.=0A= */=0A= =0A= for (infoPtr =3D tsdPtr->firstFilePtr; infoPtr !=3D NULL;=20=0A= infoPtr =3D infoPtr->nextPtr) {=0A= if (infoPtr->watchMask) {=0A= Tcl_SetMaxBlockTime(&blockTime);=0A= break;=0A= }=0A= }=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileCheckProc --=0A= *=0A= * This procedure is called by Tcl_DoOneEvent to check the file=0A= * event source for events.=20=0A= *=0A= * Results:=0A= * None.=0A= *=0A= * Side effects:=0A= * May queue an event.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static void=0A= FileCheckProc(data, flags)=0A= ClientData data; /* Not used. */=0A= int flags; /* Event flags as passed to Tcl_DoOneEvent. */=0A= {=0A= FileEvent *evPtr;=0A= FileInfo *infoPtr;=0A= ThreadSpecificData *tsdPtr =3D TCL_TSD_INIT(&dataKey);=0A= =0A= if (!(flags & TCL_FILE_EVENTS)) {=0A= return;=0A= }=0A= =20=20=20=20=0A= /*=0A= * Queue events for any ready files that don't already have events=0A= * queued (caused by persistent states that won't generate WinSock=0A= * events).=0A= */=0A= =0A= for (infoPtr =3D tsdPtr->firstFilePtr; infoPtr !=3D NULL;=20=0A= infoPtr =3D infoPtr->nextPtr) {=0A= if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {=0A= infoPtr->flags |=3D FILE_PENDING;=0A= evPtr =3D (FileEvent *) ckalloc(sizeof(FileEvent));=0A= evPtr->header.proc =3D FileEventProc;=0A= evPtr->infoPtr =3D infoPtr;=0A= Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);=0A= }=0A= }=0A= }=0A= =0C=0A= /*----------------------------------------------------------------------=0A= *=0A= * FileEventProc --=0A= *=0A= * This function is invoked by Tcl_ServiceEvent when a file event=0A= * reaches the front of the event queue. This procedure invokes=0A= * Tcl_NotifyChannel on the file.=0A= *=0A= * Results:=0A= * Returns 1 if the event was handled, meaning it should be removed=0A= * from the queue. Returns 0 if the event was not handled, meaning=0A= * it should stay on the queue. The only time the event isn't=0A= * handled is if the TCL_FILE_EVENTS flag bit isn't set.=0A= *=0A= * Side effects:=0A= * Whatever the notifier callback does.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= FileEventProc(evPtr, flags)=0A= Tcl_Event *evPtr; /* Event to service. */=0A= int flags; /* Flags that indicate what events to=0A= * handle, such as TCL_FILE_EVENTS. */=0A= {=0A= FileEvent *fileEvPtr =3D (FileEvent *)evPtr;=0A= FileInfo *infoPtr;=0A= ThreadSpecificData *tsdPtr =3D TCL_TSD_INIT(&dataKey);=0A= =0A= if (!(flags & TCL_FILE_EVENTS)) {=0A= return 0;=0A= }=0A= =0A= /*=0A= * Search through the list of watched files for the one whose handle=0A= * matches the event. We do this rather than simply dereferencing=0A= * the handle in the event so that files can be deleted while the=0A= * event is in the queue.=0A= */=0A= =0A= for (infoPtr =3D tsdPtr->firstFilePtr; infoPtr !=3D NULL;=0A= infoPtr =3D infoPtr->nextPtr) {=0A= if (fileEvPtr->infoPtr =3D=3D infoPtr) {=0A= infoPtr->flags &=3D ~(FILE_PENDING);=0A= Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);=0A= break;=0A= }=0A= }=0A= return 1;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileBlockProc --=0A= *=0A= * Set blocking or non-blocking mode on channel.=0A= *=0A= * Results:=0A= * 0 if successful, errno when failed.=0A= *=0A= * Side effects:=0A= * Sets the device into blocking or non-blocking mode.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= FileBlockProc(instanceData, mode)=0A= ClientData instanceData; /* Instance data for channel. */=0A= int mode; /* TCL_MODE_BLOCKING or=0A= * TCL_MODE_NONBLOCKING. */=0A= {=0A= FileInfo *infoPtr =3D (FileInfo *) instanceData;=0A= =20=20=20=20=0A= /*=0A= * Files on Windows can not be switched between blocking and nonblockin= g,=0A= * hence we have to emulate the behavior. This is done in the input=0A= * function by checking against a bit in the state. We set or unset the= =0A= * bit here to cause the input function to emulate the correct behavior= .=0A= */=0A= =0A= if (mode =3D=3D TCL_MODE_NONBLOCKING) {=0A= infoPtr->flags |=3D FILE_ASYNC;=0A= } else {=0A= infoPtr->flags &=3D ~(FILE_ASYNC);=0A= }=0A= return 0;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileCloseProc --=0A= *=0A= * Closes the IO channel.=0A= *=0A= * Results:=0A= * 0 if successful, the value of errno if failed.=0A= *=0A= * Side effects:=0A= * Closes the physical channel=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= FileCloseProc(instanceData, interp)=0A= ClientData instanceData; /* Pointer to FileInfo structure. */=0A= Tcl_Interp *interp; /* Not used. */=0A= {=0A= FileInfo *fileInfoPtr =3D (FileInfo *) instanceData;=0A= FileInfo **nextPtrPtr;=0A= int errorCode =3D 0;=0A= ThreadSpecificData *tsdPtr =3D TCL_TSD_INIT(&dataKey);=0A= =0A= /*=0A= * Remove the file from the watch list.=0A= */=0A= =0A= FileWatchProc(instanceData, 0);=0A= =0A= /*=0A= * Don't close the Win32 handle if the handle is a standard channel=0A= * during the exit process. Otherwise, one thread may kill the stdio= =0A= * of another.=0A= */=0A= =0A= if (!TclInExit()=20=0A= || ((GetStdHandle(STD_INPUT_HANDLE) !=3D fileInfoPtr->handle)=0A= && (GetStdHandle(STD_OUTPUT_HANDLE) !=3D fileInfoPtr->handle)=0A= && (GetStdHandle(STD_ERROR_HANDLE) !=3D fileInfoPtr->handle))) {=0A= if (CloseHandle(fileInfoPtr->handle) =3D=3D FALSE) {=0A= TclWinConvertError(GetLastError());=0A= errorCode =3D errno;=0A= }=0A= }=0A= for (nextPtrPtr =3D &(tsdPtr->firstFilePtr); (*nextPtrPtr) !=3D NULL;= =0A= nextPtrPtr =3D &((*nextPtrPtr)->nextPtr)) {=0A= if ((*nextPtrPtr) =3D=3D fileInfoPtr) {=0A= (*nextPtrPtr) =3D fileInfoPtr->nextPtr;=0A= break;=0A= }=0A= }=0A= ckfree((char *)fileInfoPtr);=0A= return errorCode;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileSeekProc --=0A= *=0A= * Seeks on a file-based channel. Returns the new position.=0A= *=0A= * Results:=0A= * -1 if failed, the new position if successful. If failed, it=0A= * also sets *errorCodePtr to the error code.=0A= *=0A= * Side effects:=0A= * Moves the location at which the channel will be accessed in=0A= * future operations.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= FileSeekProc(instanceData, offset, mode, errorCodePtr)=0A= ClientData instanceData; /* File state. */=0A= long offset; /* Offset to seek to. */=0A= int mode; /* Relative to where should we seek? */=0A= int *errorCodePtr; /* To store error code. */=0A= {=0A= FileInfo *infoPtr =3D (FileInfo *) instanceData;=0A= DWORD moveMethod;=0A= DWORD newPos, newPosHigh;=0A= DWORD oldPos, oldPosHigh;=0A= =0A= *errorCodePtr =3D 0;=0A= if (mode =3D=3D SEEK_SET) {=0A= moveMethod =3D FILE_BEGIN;=0A= } else if (mode =3D=3D SEEK_CUR) {=0A= moveMethod =3D FILE_CURRENT;=0A= } else {=0A= moveMethod =3D FILE_END;=0A= }=0A= =0A= /*=0A= * Save our current place in case we need to roll-back the seek.=0A= */=0A= oldPosHigh =3D (DWORD)0;=0A= oldPos =3D SetFilePointer(infoPtr->handle, (LONG)0, &oldPosHigh,=0A= FILE_CURRENT);=0A= if (oldPos =3D=3D INVALID_SET_FILE_POINTER) {=0A= int winError =3D GetLastError();=0A= if (winError !=3D NO_ERROR) {=0A= TclWinConvertError(winError);=0A= *errorCodePtr =3D errno;=0A= return -1;=0A= }=0A= }=0A= =0A= newPosHigh =3D (DWORD)(offset < 0 ? -1 : 0);=0A= newPos =3D SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,= =0A= moveMethod);=0A= if (newPos =3D=3D INVALID_SET_FILE_POINTER) {=0A= int winError =3D GetLastError();=0A= if (winError !=3D NO_ERROR) {=0A= TclWinConvertError(winError);=0A= *errorCodePtr =3D errno;=0A= return -1;=0A= }=0A= }=0A= =0A= /*=0A= * Check for expressability in our return type, and roll-back otherwise= .=0A= */=0A= if (newPosHigh !=3D 0) {=0A= *errorCodePtr =3D EOVERFLOW;=0A= SetFilePointer(infoPtr->handle, (LONG)oldPos, &oldPosHigh, FILE_BEGIN);=0A= return -1;=0A= }=0A= return (int) newPos;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileWideSeekProc --=0A= *=0A= * Seeks on a file-based channel. Returns the new position.=0A= *=0A= * Results:=0A= * -1 if failed, the new position if successful. If failed, it=0A= * also sets *errorCodePtr to the error code.=0A= *=0A= * Side effects:=0A= * Moves the location at which the channel will be accessed in=0A= * future operations.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static Tcl_WideInt=0A= FileWideSeekProc(instanceData, offset, mode, errorCodePtr)=0A= ClientData instanceData; /* File state. */=0A= Tcl_WideInt offset; /* Offset to seek to. */=0A= int mode; /* Relative to where should we seek? */=0A= int *errorCodePtr; /* To store error code. */=0A= {=0A= FileInfo *infoPtr =3D (FileInfo *) instanceData;=0A= DWORD moveMethod;=0A= DWORD newPos, newPosHigh;=0A= =0A= *errorCodePtr =3D 0;=0A= if (mode =3D=3D SEEK_SET) {=0A= moveMethod =3D FILE_BEGIN;=0A= } else if (mode =3D=3D SEEK_CUR) {=0A= moveMethod =3D FILE_CURRENT;=0A= } else {=0A= moveMethod =3D FILE_END;=0A= }=0A= =0A= newPosHigh =3D (DWORD)(offset >> 32);=0A= newPos =3D SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,= =0A= moveMethod);=0A= if (newPos =3D=3D INVALID_SET_FILE_POINTER) {=0A= int winError =3D GetLastError();=0A= if (winError !=3D NO_ERROR) {=0A= TclWinConvertError(winError);=0A= *errorCodePtr =3D errno;=0A= return -1;=0A= }=0A= }=0A= return ((Tcl_WideInt) newPos) | (((Tcl_WideInt) newPosHigh) << 32);=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileInputProc --=0A= *=0A= * Reads input from the IO channel into the buffer given. Returns=0A= * count of how many bytes were actually read, and an error indication.=0A= *=0A= * Results:=0A= * A count of how many bytes were read is returned and an error=0A= * indication is returned in an output argument.=0A= *=0A= * Side effects:=0A= * Reads input from the actual channel.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= FileInputProc(instanceData, buf, bufSize, errorCode)=0A= ClientData instanceData; /* File state. */=0A= char *buf; /* Where to store data read. */=0A= int bufSize; /* How much space is available=0A= * in the buffer? */=0A= int *errorCode; /* Where to store error code. */=0A= {=0A= FileInfo *infoPtr;=0A= DWORD bytesRead;=0A= =0A= *errorCode =3D 0;=0A= infoPtr =3D (FileInfo *) instanceData;=0A= =0A= /*=0A= * Note that we will block on reads from a console buffer until a=0A= * full line has been entered. The only way I know of to get=0A= * around this is to write a console driver. We should probably=0A= * do this at some point, but for now, we just block. The same=0A= * problem exists for files being read over the network.=0A= */=0A= =0A= if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead= ,=0A= (LPOVERLAPPED) NULL) !=3D FALSE) {=0A= return bytesRead;=0A= }=0A= =20=20=20=20=0A= TclWinConvertError(GetLastError());=0A= *errorCode =3D errno;=0A= if (errno =3D=3D EPIPE) {=0A= return 0;=0A= }=0A= return -1;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileOutputProc --=0A= *=0A= * Writes the given output on the IO channel. Returns count of how=0A= * many characters were actually written, and an error indication.=0A= *=0A= * Results:=0A= * A count of how many characters were written is returned and an=0A= * error indication is returned in an output argument.=0A= *=0A= * Side effects:=0A= * Writes output on the actual channel.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= FileOutputProc(instanceData, buf, toWrite, errorCode)=0A= ClientData instanceData; /* File state. */=0A= CONST char *buf; /* The data buffer. */=0A= int toWrite; /* How many bytes to write? */=0A= int *errorCode; /* Where to store error code. */=0A= {=0A= FileInfo *infoPtr =3D (FileInfo *) instanceData;=0A= DWORD bytesWritten;=0A= =20=20=20=20=0A= *errorCode =3D 0;=0A= =0A= /*=0A= * If we are writing to a file that was opened with O_APPEND, we need t= o=0A= * seek to the end of the file before writing the current buffer.=0A= */=0A= =0A= if (infoPtr->flags & FILE_APPEND) {=0A= SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);=0A= }=0A= =0A= if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWri= tten,=0A= (LPOVERLAPPED) NULL) =3D=3D FALSE) {=0A= TclWinConvertError(GetLastError());=0A= *errorCode =3D errno;=0A= return -1;=0A= }=0A= infoPtr->dirty =3D 1;=0A= return bytesWritten;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileWatchProc --=0A= *=0A= * Called by the notifier to set up to watch for events on this=0A= * channel.=0A= *=0A= * Results:=0A= * None.=0A= *=0A= * Side effects:=0A= * None.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static void=0A= FileWatchProc(instanceData, mask)=0A= ClientData instanceData; /* File state. */=0A= int mask; /* What events to watch for; OR-ed=0A= * combination of TCL_READABLE,=0A= * TCL_WRITABLE and TCL_EXCEPTION. = */=0A= {=0A= FileInfo *infoPtr =3D (FileInfo *) instanceData;=0A= Tcl_Time blockTime =3D { 0, 0 };=0A= =0A= /*=0A= * Since the file is always ready for events, we set the block time=0A= * to zero so we will poll.=0A= */=0A= =0A= infoPtr->watchMask =3D mask & infoPtr->validMask;=0A= if (infoPtr->watchMask) {=0A= Tcl_SetMaxBlockTime(&blockTime);=0A= }=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * FileGetHandleProc --=0A= *=0A= * Called from Tcl_GetChannelHandle to retrieve OS handles from=0A= * a file based channel.=0A= *=0A= * Results:=0A= * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if=0A= * there is no handle for the specified direction.=20=0A= *=0A= * Side effects:=0A= * None.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= static int=0A= FileGetHandleProc(instanceData, direction, handlePtr)=0A= ClientData instanceData; /* The file state. */=0A= int direction; /* TCL_READABLE or TCL_WRITABLE */=0A= ClientData *handlePtr; /* Where to store the handle. */=0A= {=0A= FileInfo *infoPtr =3D (FileInfo *) instanceData;=0A= =0A= if (direction & infoPtr->validMask) {=0A= *handlePtr =3D (ClientData) infoPtr->handle;=0A= return TCL_OK;=0A= } else {=0A= return TCL_ERROR;=0A= }=0A= }=0A= =0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TclpOpenFileChannel --=0A= *=0A= * Open an File based channel on Unix systems.=0A= *=0A= * Results:=0A= * The new channel or NULL. If NULL, the output argument=0A= * errorCodePtr is set to a POSIX error.=0A= *=0A= * Side effects:=0A= * May open the channel and may cause creation of a file on the=0A= * file system.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= Tcl_Channel=0A= TclpOpenFileChannel(interp, pathPtr, mode, permissions)=0A= Tcl_Interp *interp; /* Interpreter for error reporting;=0A= * can be NULL. */=0A= Tcl_Obj *pathPtr; /* Name of file to open. */=0A= int mode; /* POSIX mode. */=0A= int permissions; /* If the open involves creating a=0A= * file, with what modes to create= =0A= * it? */=0A= {=0A= Tcl_Channel channel =3D 0;=0A= int channelPermissions;=0A= DWORD accessMode, createMode, shareMode, flags, consoleParams, type;=0A= CONST TCHAR *nativeName;=0A= DCB dcb;=0A= HANDLE handle;=0A= char channelName[16 + TCL_INTEGER_SPACE];=0A= TclFile readFile =3D NULL;=0A= TclFile writeFile =3D NULL;=0A= =0A= nativeName =3D (TCHAR*) Tcl_FSGetNativePath(pathPtr);=0A= if (nativeName =3D=3D NULL) {=0A= return NULL;=0A= }=0A= =20=20=20=20=0A= switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {=0A= case O_RDONLY:=0A= accessMode =3D GENERIC_READ;=0A= channelPermissions =3D TCL_READABLE;=0A= break;=0A= case O_WRONLY:=0A= accessMode =3D GENERIC_WRITE;=0A= channelPermissions =3D TCL_WRITABLE;=0A= break;=0A= case O_RDWR:=0A= accessMode =3D (GENERIC_READ | GENERIC_WRITE);=0A= channelPermissions =3D (TCL_READABLE | TCL_WRITABLE);=0A= break;=0A= default:=0A= panic("TclpOpenFileChannel: invalid mode value");=0A= break;=0A= }=0A= =0A= /*=0A= * Map the creation flags to the NT create mode.=0A= */=0A= =0A= switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {=0A= case (O_CREAT | O_EXCL):=0A= case (O_CREAT | O_EXCL | O_TRUNC):=0A= createMode =3D CREATE_NEW;=0A= break;=0A= case (O_CREAT | O_TRUNC):=0A= createMode =3D CREATE_ALWAYS;=0A= break;=0A= case O_CREAT:=0A= createMode =3D OPEN_ALWAYS;=0A= break;=0A= case O_TRUNC:=0A= case (O_TRUNC | O_EXCL):=0A= createMode =3D TRUNCATE_EXISTING;=0A= break;=0A= default:=0A= createMode =3D OPEN_EXISTING;=0A= break;=0A= }=0A= =0A= /*=0A= * If the file is being created, get the file attributes from the=0A= * permissions argument, else use the existing file attributes.=0A= */=0A= =0A= if (mode & O_CREAT) {=0A= if (permissions & S_IWRITE) {=0A= flags =3D FILE_ATTRIBUTE_NORMAL;=0A= } else {=0A= flags =3D FILE_ATTRIBUTE_READONLY;=0A= }=0A= } else {=0A= flags =3D (*tclWinProcs->getFileAttributesProc)(nativeName);=0A= if (flags =3D=3D 0xFFFFFFFF) {=0A= flags =3D 0;=0A= }=0A= }=0A= =0A= /*=0A= * Set up the file sharing mode. We want to allow simultaneous access.= =0A= */=0A= =0A= shareMode =3D FILE_SHARE_READ | FILE_SHARE_WRITE;=0A= =0A= /*=0A= * Now we get to create the file.=0A= */=0A= =0A= handle =3D (*tclWinProcs->createFileProc)(nativeName, accessMode,=20=0A= shareMode, NULL, createMode, flags, (HANDLE) NULL);=0A= =0A= if (handle =3D=3D INVALID_HANDLE_VALUE) {=0A= DWORD err;=0A= err =3D GetLastError();=0A= if ((err & 0xffffL) =3D=3D ERROR_OPEN_FAILED) {=0A= err =3D (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;= =0A= }=0A= TclWinConvertError(err);=0A= if (interp !=3D (Tcl_Interp *) NULL) {=0A= Tcl_AppendResult(interp, "couldn't open \"",=20=0A= Tcl_GetString(pathPtr), "\": ",=0A= Tcl_PosixError(interp), (char *) NULL);=0A= }=0A= return NULL;=0A= }=0A= =20=20=20=20=0A= type =3D GetFileType(handle);=0A= =0A= /*=0A= * If the file is a character device, we need to try to figure out=0A= * whether it is a serial port, a console, or something else. We=0A= * test for the console case first because this is more common.=0A= */=0A= =0A= if (type =3D=3D FILE_TYPE_CHAR) {=0A= if (GetConsoleMode(handle, &consoleParams)) {=0A= type =3D FILE_TYPE_CONSOLE;=0A= } else {=0A= dcb.DCBlength =3D sizeof( DCB ) ;=0A= if (GetCommState(handle, &dcb)) {=0A= type =3D FILE_TYPE_SERIAL;=0A= }=0A= =09=09=20=20=20=20=0A= }=0A= }=0A= =0A= channel =3D NULL;=0A= =0A= switch (type) {=0A= case FILE_TYPE_SERIAL:=0A= /*=0A= * Reopen channel for OVERLAPPED operation=0A= * Normally this shouldn't fail, because the channel exists=0A= */=0A= handle =3D TclWinSerialReopen(handle, nativeName, accessMode);=0A= if (handle =3D=3D INVALID_HANDLE_VALUE) {=0A= TclWinConvertError(GetLastError());=0A= if (interp !=3D (Tcl_Interp *) NULL) {=0A= Tcl_AppendResult(interp, "couldn't reopen serial \"",=0A= Tcl_GetString(pathPtr), "\": ",=0A= Tcl_PosixError(interp), (char *) NULL);=0A= }=0A= return NULL;=0A= }=0A= channel =3D TclWinOpenSerialChannel(handle, channelName,=0A= channelPermissions);=0A= break;=0A= case FILE_TYPE_CONSOLE:=0A= channel =3D TclWinOpenConsoleChannel(handle, channelName,=0A= channelPermissions);=0A= break;=0A= case FILE_TYPE_PIPE:=0A= if (channelPermissions & TCL_READABLE) {=0A= readFile =3D TclWinMakeFile(handle);=0A= }=0A= if (channelPermissions & TCL_WRITABLE) {=0A= writeFile =3D TclWinMakeFile(handle);=0A= }=0A= channel =3D TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);= =0A= break;=0A= case FILE_TYPE_CHAR:=0A= case FILE_TYPE_DISK:=0A= case FILE_TYPE_UNKNOWN:=0A= channel =3D TclWinOpenFileChannel(handle, channelName,=0A= channelPermissions,=0A= (mode & O_APPEND) ? FILE_APPEND : 0);=0A= break;=0A= =0A= default:=0A= /*=0A= * The handle is of an unknown type, probably /dev/nul equivalent=0A= * or possibly a closed handle.=20=20=0A= */=0A= =09=0A= channel =3D NULL;=0A= Tcl_AppendResult(interp, "couldn't open \"",=20=0A= Tcl_GetString(pathPtr), "\": ",=0A= "bad file type", (char *) NULL);=0A= break;=0A= }=0A= =0A= return channel;=0A= }=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * Tcl_MakeFileChannel --=0A= *=0A= * Creates a Tcl_Channel from an existing platform specific file=0A= * handle.=0A= *=0A= * Results:=0A= * The Tcl_Channel created around the preexisting file.=0A= *=0A= * Side effects:=0A= * None.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= Tcl_Channel=0A= Tcl_MakeFileChannel(rawHandle, mode)=0A= ClientData rawHandle; /* OS level handle */=0A= int mode; /* ORed combination of TCL_READABLE and=0A= * TCL_WRITABLE to indicate file mode. */= =0A= {=0A= char channelName[16 + TCL_INTEGER_SPACE];=0A= Tcl_Channel channel =3D NULL;=0A= HANDLE handle =3D (HANDLE) rawHandle;=0A= HANDLE dupedHandle;=0A= DCB dcb;=0A= DWORD consoleParams, type;=0A= TclFile readFile =3D NULL;=0A= TclFile writeFile =3D NULL;=0A= BOOL result;=0A= =0A= if (mode =3D=3D 0) {=0A= return NULL;=0A= }=0A= =0A= /*=0A= * GetFileType() returns FILE_TYPE_UNKNOWN for invalid handles.=0A= */=0A= =0A= type =3D GetFileType(handle);=0A= =0A= /*=0A= * If the file is a character device, we need to try to figure out=0A= * whether it is a serial port, a console, or something else. We=0A= * test for the console case first because this is more common.=0A= */=0A= =0A= if (type =3D=3D FILE_TYPE_CHAR) {=0A= if (GetConsoleMode(handle, &consoleParams)) {=0A= type =3D FILE_TYPE_CONSOLE;=0A= } else {=0A= dcb.DCBlength =3D sizeof( DCB ) ;=0A= if (GetCommState(handle, &dcb)) {=0A= type =3D FILE_TYPE_SERIAL;=0A= }=0A= }=0A= }=0A= =0A= switch (type)=0A= {=0A= case FILE_TYPE_SERIAL:=0A= channel =3D TclWinOpenSerialChannel(handle, channelName, mode);=0A= break;=0A= case FILE_TYPE_CONSOLE:=0A= channel =3D TclWinOpenConsoleChannel(handle, channelName, mode);=0A= break;=0A= case FILE_TYPE_PIPE:=0A= if (mode & TCL_READABLE)=0A= {=0A= readFile =3D TclWinMakeFile(handle);=0A= }=0A= if (mode & TCL_WRITABLE)=0A= {=0A= writeFile =3D TclWinMakeFile(handle);=0A= }=0A= channel =3D TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);= =0A= break;=0A= =0A= case FILE_TYPE_DISK:=0A= case FILE_TYPE_CHAR:=0A= channel =3D TclWinOpenFileChannel(handle, channelName, mode, 0);=0A= break;=0A= =09=0A= case FILE_TYPE_UNKNOWN:=0A= default:=0A= /*=0A= * The handle is of an unknown type. Test the validity of this OS=0A= * handle by duplicating it, then closing the dupe. The Win32 API=0A= * doesn't provide an IsValidHandle() function, so we have to emulate=0A= * it here. This test will not work on a console handle reliably,=0A= * which is why we can't test every handle that comes into this=0A= * function in this way.=0A= */=0A= =0A= result =3D DuplicateHandle(GetCurrentProcess(), handle,=0A= GetCurrentProcess(), &dupedHandle, 0, FALSE,=0A= DUPLICATE_SAME_ACCESS);=0A= =0A= if (result !=3D 0) {=0A= /*=20=0A= * Unable to make a duplicate. It's definately invalid at this=0A= * point.=0A= */=0A= =0A= return NULL;=0A= }=0A= =0A= /*=0A= * Use structured exception handling (Win32 SEH) to protect the close=0A= * of this duped handle which might throw EXCEPTION_INVALID_HANDLE.=0A= */=0A= =0A= #ifdef HAVE_NO_SEH=0A= __asm__ __volatile__ (=0A= "movl %esp, _ESP" "\n\t"=0A= "movl %ebp, _EBP");=0A= =0A= __asm__ __volatile__ (=0A= "pushl $__except_makefilechannel_handler" "\n\t"=0A= "pushl %fs:0" "\n\t"=0A= "mov %esp, %fs:0");=0A= =0A= result =3D 0;=0A= #else=0A= __try {=0A= #endif /* HAVE_NO_SEH */=0A= CloseHandle(dupedHandle);=0A= #ifdef HAVE_NO_SEH=0A= __asm__ __volatile__ (=0A= "jmp makefilechannel_pop" "\n"=0A= "makefilechannel_reentry:" "\n\t"=0A= "movl _ESP, %esp" "\n\t"=0A= "movl _EBP, %ebp");=0A= =0A= result =3D 1; /* True when exception was raised */=0A= =0A= __asm__ __volatile__ (=0A= "makefilechannel_pop:" "\n\t"=0A= "mov (%esp), %eax" "\n\t"=0A= "mov %eax, %fs:0" "\n\t"=0A= "add $8, %esp");=0A= =0A= if (result)=0A= return NULL;=0A= #else=0A= }=0A= __except (EXCEPTION_EXECUTE_HANDLER) {=0A= /*=0A= * Definately an invalid handle. So, therefore, the original=0A= * is invalid also.=0A= */=0A= =0A= return NULL;=0A= }=0A= #endif /* HAVE_NO_SEH */=0A= =0A= /* Fall through, the handle is valid. */=0A= =0A= /*=0A= * Create the undefined channel, anyways, because we know the handle=0A= * is valid to something.=0A= */=0A= =0A= channel =3D TclWinOpenFileChannel(handle, channelName, mode, 0);=0A= }=0A= =0A= return channel;=0A= }=0A= #ifdef HAVE_NO_SEH=0A= static=0A= __attribute__ ((used,/* pir - 23.12.2005 */cdecl))=0A= EXCEPTION_DISPOSITION=0A= _except_makefilechannel_handler(=0A= struct _EXCEPTION_RECORD *ExceptionRecord,=0A= void *EstablisherFrame,=0A= struct _CONTEXT *ContextRecord,=0A= void *DispatcherContext)=0A= {=0A= __asm__ __volatile__ (=0A= "jmp makefilechannel_reentry");=0A= return 0; /* Function does not return */=0A= }=0A= #endif=0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TclpGetDefaultStdChannel --=0A= *=0A= * Constructs a channel for the specified standard OS handle.=0A= *=0A= * Results:=0A= * Returns the specified default standard channel, or NULL.=0A= *=0A= * Side effects:=0A= * May cause the creation of a standard channel and the underlying=0A= * file.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= Tcl_Channel=0A= TclpGetDefaultStdChannel(type)=0A= int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */=0A= {=0A= Tcl_Channel channel;=0A= HANDLE handle;=0A= int mode;=0A= char *bufMode;=0A= DWORD handleId; /* Standard handle to retrieve. */=0A= =0A= =0A= switch (type) {=0A= case TCL_STDIN:=0A= handleId =3D STD_INPUT_HANDLE;=0A= mode =3D TCL_READABLE;=0A= bufMode =3D "line";=0A= break;=0A= case TCL_STDOUT:=0A= handleId =3D STD_OUTPUT_HANDLE;=0A= mode =3D TCL_WRITABLE;=0A= bufMode =3D "line";=0A= break;=0A= case TCL_STDERR:=0A= handleId =3D STD_ERROR_HANDLE;=0A= mode =3D TCL_WRITABLE;=0A= bufMode =3D "none";=0A= break;=0A= default:=0A= panic("TclGetDefaultStdChannel: Unexpected channel type");=0A= break;=0A= }=0A= =0A= handle =3D GetStdHandle(handleId);=0A= =0A= /*=0A= * Note that we need to check for 0 because Windows may return 0 if thi= s=0A= * is not a console mode application, even though this is not a valid= =0A= * handle.=0A= */=0A= =0A= if ((handle =3D=3D INVALID_HANDLE_VALUE) || (handle =3D=3D 0)) {=0A= return (Tcl_Channel) NULL;=0A= }=0A= =0A= channel =3D Tcl_MakeFileChannel(handle, mode);=0A= =0A= if (channel =3D=3D NULL) {=0A= return (Tcl_Channel) NULL;=0A= }=0A= =0A= /*=0A= * Set up the normal channel options for stdio handles.=0A= */=0A= =0A= if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",= =0A= "auto") =3D=3D TCL_ERROR)=0A= || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",=0A= "\032 {}") =3D=3D TCL_ERROR)=0A= || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,=0A= "-buffering", bufMode) =3D=3D TCL_ERROR)) {=0A= Tcl_Close((Tcl_Interp *) NULL, channel);=0A= return (Tcl_Channel) NULL;=0A= }=0A= return channel;=0A= }=0A= =0A= =0A= =0C=0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TclWinOpenFileChannel --=0A= *=0A= * Constructs a File channel for the specified standard OS handle.=0A= * This is a helper function to break up the construction of=20=0A= * channels into File, Console, or Serial.=0A= *=0A= * Results:=0A= * Returns the new channel, or NULL.=0A= *=0A= * Side effects:=0A= * May open the channel and may cause creation of a file on the=0A= * file system.=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= Tcl_Channel=0A= TclWinOpenFileChannel(handle, channelName, permissions, appendMode)=0A= HANDLE handle;=0A= char *channelName;=0A= int permissions;=0A= int appendMode;=0A= {=0A= FileInfo *infoPtr;=0A= ThreadSpecificData *tsdPtr;=0A= =0A= tsdPtr =3D FileInit();=0A= =0A= /*=0A= * See if a channel with this handle already exists.=0A= */=0A= =20=20=20=20=0A= for (infoPtr =3D tsdPtr->firstFilePtr; infoPtr !=3D NULL;=20=0A= infoPtr =3D infoPtr->nextPtr) {=0A= if (infoPtr->handle =3D=3D (HANDLE) handle) {=0A= return (permissions =3D=3D infoPtr->validMask) ? infoPtr->channel : NU= LL;=0A= }=0A= }=0A= =0A= infoPtr =3D (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));=0A= infoPtr->nextPtr =3D tsdPtr->firstFilePtr;=0A= tsdPtr->firstFilePtr =3D infoPtr;=0A= infoPtr->validMask =3D permissions;=0A= infoPtr->watchMask =3D 0;=0A= infoPtr->flags =3D appendMode;=0A= infoPtr->handle =3D handle;=0A= infoPtr->dirty =3D 0;=0A= wsprintfA(channelName, "file%lx", (int) infoPtr);=0A= =20=20=20=20=0A= infoPtr->channel =3D Tcl_CreateChannel(&fileChannelType, channelName,= =0A= (ClientData) infoPtr, permissions);=0A= =20=20=20=20=0A= /*=0A= * Files have default translation of AUTO and ^Z eof char, which=0A= * means that a ^Z will be accepted as EOF when reading.=0A= */=0A= =20=20=20=20=0A= Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");= =0A= Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");=0A= =0A= return infoPtr->channel;=0A= }=0A= =0A= =0A= /*=0A= *----------------------------------------------------------------------=0A= *=0A= * TclWinFlushDirtyChannels --=0A= *=0A= * Flush all dirty channels to disk, so that requesting the=0A= * size of any file returns the correct value.=0A= *=0A= * Results:=0A= * None.=0A= *=0A= * Side effects:=0A= * Information is actually written to disk now, rather than=0A= * later. Don't call this too often, or there will be a=20=0A= * performance hit (i.e. only call when we need to ask for=0A= * the size of a file).=0A= *=0A= *----------------------------------------------------------------------=0A= */=0A= =0A= void=0A= TclWinFlushDirtyChannels ()=0A= {=0A= FileInfo *infoPtr;=0A= ThreadSpecificData *tsdPtr;=0A= =0A= tsdPtr =3D FileInit();=0A= =0A= /*=0A= * Flush all channels which are dirty, i.e. may have data pending=0A= * in the OS=0A= */=0A= =20=20=20=20=0A= for (infoPtr =3D tsdPtr->firstFilePtr;=0A= infoPtr !=3D NULL;=20=0A= infoPtr =3D infoPtr->nextPtr) {=0A= if (infoPtr->dirty) {=0A= FlushFileBuffers(infoPtr->handle);=0A= infoPtr->dirty =3D 0;=0A= }=0A= }=0A= }=0A= ------=_NextPart_000_0003_01C607DB.40902AA0--