diff options
Diffstat (limited to 'generic/tclIOUtil.c')
| -rw-r--r-- | generic/tclIOUtil.c | 876 |
1 files changed, 0 insertions, 876 deletions
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c deleted file mode 100644 index 6a00e54..0000000 --- a/generic/tclIOUtil.c +++ /dev/null @@ -1,876 +0,0 @@ -/* - * tclIOUtil.c -- - * - * This file contains a collection of utility procedures that - * are shared by the platform specific IO drivers. - * - * Parts of this file are based on code contributed by Karl - * Lehenbauer, Mark Diekhans and Peter da Silva. - * - * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1997 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclIOUtil.c,v 1.6 1999/04/16 00:46:47 stanton Exp $ - */ - -#include "tclInt.h" -#include "tclPort.h" - -/* - * The following typedef declarations allow for hooking into the chain - * of functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' & - * 'Tcl_OpenFileChannel(...)'. Basically for each hookable function - * a linked list is defined. - */ - -typedef struct StatProc { - TclStatProc_ *proc; /* Function to process a 'stat()' call */ - struct StatProc *nextPtr; /* The next 'stat()' function to call */ -} StatProc; - -typedef struct AccessProc { - TclAccessProc_ *proc; /* Function to process a 'access()' call */ - struct AccessProc *nextPtr; /* The next 'access()' function to call */ -} AccessProc; - -typedef struct OpenFileChannelProc { - TclOpenFileChannelProc_ *proc; /* Function to process a - * 'Tcl_OpenFileChannel()' call */ - struct OpenFileChannelProc *nextPtr; - /* The next 'Tcl_OpenFileChannel()' - * function to call */ -} OpenFileChannelProc; - -/* - * For each type of hookable function, a static node is declared to - * hold the function pointer for the "built-in" routine (e.g. - * 'TclpStat(...)') and the respective list is initialized as a pointer - * to that node. - * - * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that - * these statically declared list entry cannot be inadvertently removed. - * - * This method avoids the need to call any sort of "initialization" - * function. - * - * All three lists are protected by a global hookMutex. - */ - -static StatProc defaultStatProc = { - &TclpStat, NULL -}; -static StatProc *statProcList = &defaultStatProc; - -static AccessProc defaultAccessProc = { - &TclpAccess, NULL -}; -static AccessProc *accessProcList = &defaultAccessProc; - -static OpenFileChannelProc defaultOpenFileChannelProc = { - &TclpOpenFileChannel, NULL -}; -static OpenFileChannelProc *openFileChannelProcList = - &defaultOpenFileChannelProc; - -TCL_DECLARE_MUTEX(hookMutex) - -/* - *--------------------------------------------------------------------------- - * - * TclGetOpenMode -- - * - * Description: - * Computes a POSIX mode mask for opening a file, from a given string, - * and also sets a flag to indicate whether the caller should seek to - * EOF after opening the file. - * - * Results: - * On success, returns mode to pass to "open". If an error occurs, the - * return value is -1 and if interp is not NULL, sets interp's result - * object to an error message. - * - * Side effects: - * Sets the integer referenced by seekFlagPtr to 1 to tell the caller - * to seek to EOF after opening the file. - * - * Special note: - * This code is based on a prototype implementation contributed - * by Mark Diekhans. - * - *--------------------------------------------------------------------------- - */ - -int -TclGetOpenMode(interp, string, seekFlagPtr) - Tcl_Interp *interp; /* Interpreter to use for error - * reporting - may be NULL. */ - char *string; /* Mode string, e.g. "r+" or - * "RDONLY CREAT". */ - int *seekFlagPtr; /* Set this to 1 if the caller - * should seek to EOF during the - * opening of the file. */ -{ - int mode, modeArgc, c, i, gotRW; - char **modeArgv, *flag; -#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR) - - /* - * Check for the simpler fopen-like access modes (e.g. "r"). They - * are distinguished from the POSIX access modes by the presence - * of a lower-case first letter. - */ - - *seekFlagPtr = 0; - mode = 0; - - /* - * Guard against international characters before using byte oriented - * routines. - */ - - if (!(string[0] & 0x80) - && islower(UCHAR(string[0]))) { /* INTL: ISO only. */ - switch (string[0]) { - case 'r': - mode = O_RDONLY; - break; - case 'w': - mode = O_WRONLY|O_CREAT|O_TRUNC; - break; - case 'a': - mode = O_WRONLY|O_CREAT; - *seekFlagPtr = 1; - break; - default: - error: - if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, - "illegal access mode \"", string, "\"", - (char *) NULL); - } - return -1; - } - if (string[1] == '+') { - mode &= ~(O_RDONLY|O_WRONLY); - mode |= O_RDWR; - if (string[2] != 0) { - goto error; - } - } else if (string[1] != 0) { - goto error; - } - return mode; - } - - /* - * The access modes are specified using a list of POSIX modes - * such as O_CREAT. - * - * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when - * a NULL interpreter is passed in. - */ - - if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) { - if (interp != (Tcl_Interp *) NULL) { - Tcl_AddErrorInfo(interp, - "\n while processing open access modes \""); - Tcl_AddErrorInfo(interp, string); - Tcl_AddErrorInfo(interp, "\""); - } - return -1; - } - - gotRW = 0; - for (i = 0; i < modeArgc; i++) { - flag = modeArgv[i]; - c = flag[0]; - if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) { - mode = (mode & ~RW_MODES) | O_RDONLY; - gotRW = 1; - } else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) { - mode = (mode & ~RW_MODES) | O_WRONLY; - gotRW = 1; - } else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) { - mode = (mode & ~RW_MODES) | O_RDWR; - gotRW = 1; - } else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) { - mode |= O_APPEND; - *seekFlagPtr = 1; - } else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) { - mode |= O_CREAT; - } else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) { - mode |= O_EXCL; - } else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) { -#ifdef O_NOCTTY - mode |= O_NOCTTY; -#else - if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "access mode \"", flag, - "\" not supported by this system", (char *) NULL); - } - ckfree((char *) modeArgv); - return -1; -#endif - } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) { -#if defined(O_NDELAY) || defined(O_NONBLOCK) -# ifdef O_NONBLOCK - mode |= O_NONBLOCK; -# else - mode |= O_NDELAY; -# endif -#else - if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "access mode \"", flag, - "\" not supported by this system", (char *) NULL); - } - ckfree((char *) modeArgv); - return -1; -#endif - } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) { - mode |= O_TRUNC; - } else { - if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "invalid access mode \"", flag, - "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT", - " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL); - } - ckfree((char *) modeArgv); - return -1; - } - } - ckfree((char *) modeArgv); - if (!gotRW) { - if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "access mode must include either", - " RDONLY, WRONLY, or RDWR", (char *) NULL); - } - return -1; - } - return mode; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_EvalFile -- - * - * Read in a file and process the entire file as one gigantic - * Tcl command. - * - * Results: - * A standard Tcl result, which is either the result of executing - * the file or an error indicating why the file couldn't be read. - * - * Side effects: - * Depends on the commands in the file. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_EvalFile(interp, fileName) - Tcl_Interp *interp; /* Interpreter in which to process file. */ - char *fileName; /* Name of file to process. Tilde-substitution - * will be performed on this name. */ -{ - int result, length; - struct stat statBuf; - char *oldScriptFile; - Interp *iPtr; - Tcl_DString nameString; - char *name, *string; - Tcl_Channel chan; - Tcl_Obj *objPtr; - - name = Tcl_TranslateFileName(interp, fileName, &nameString); - if (name == NULL) { - return TCL_ERROR; - } - - result = TCL_ERROR; - objPtr = Tcl_NewObj(); - - if (TclStat(name, &statBuf) == -1) { - Tcl_SetErrno(errno); - Tcl_AppendResult(interp, "couldn't read file \"", fileName, - "\": ", Tcl_PosixError(interp), (char *) NULL); - goto end; - } - chan = Tcl_OpenFileChannel(interp, name, "r", 0644); - if (chan == (Tcl_Channel) NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't read file \"", fileName, - "\": ", Tcl_PosixError(interp), (char *) NULL); - goto end; - } - if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) { - Tcl_Close(interp, chan); - Tcl_AppendResult(interp, "couldn't read file \"", fileName, - "\": ", Tcl_PosixError(interp), (char *) NULL); - goto end; - } - if (Tcl_Close(interp, chan) != TCL_OK) { - goto end; - } - - iPtr = (Interp *) interp; - oldScriptFile = iPtr->scriptFile; - iPtr->scriptFile = fileName; - string = Tcl_GetStringFromObj(objPtr, &length); - result = Tcl_EvalEx(interp, string, length, 0); - iPtr->scriptFile = oldScriptFile; - - if (result == TCL_RETURN) { - result = TclUpdateReturnInfo(iPtr); - } else if (result == TCL_ERROR) { - char msg[200 + TCL_INTEGER_SPACE]; - - /* - * Record information telling where the error occurred. - */ - - sprintf(msg, "\n (file \"%.150s\" line %d)", fileName, - interp->errorLine); - Tcl_AddErrorInfo(interp, msg); - } - - end: - Tcl_DecrRefCount(objPtr); - Tcl_DStringFree(&nameString); - return result; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetErrno -- - * - * Gets the current value of the Tcl error code variable. This is - * currently the global variable "errno" but could in the future - * change to something else. - * - * Results: - * The value of the Tcl error code variable. - * - * Side effects: - * None. Note that the value of the Tcl error code variable is - * UNDEFINED if a call to Tcl_SetErrno did not precede this call. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_GetErrno() -{ - return errno; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetErrno -- - * - * Sets the Tcl error code variable to the supplied value. - * - * Results: - * None. - * - * Side effects: - * Modifies the value of the Tcl error code variable. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SetErrno(err) - int err; /* The new value. */ -{ - errno = err; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_PosixError -- - * - * This procedure is typically called after UNIX kernel calls - * return errors. It stores machine-readable information about - * the error in $errorCode returns an information string for - * the caller's use. - * - * Results: - * The return value is a human-readable string describing the - * error. - * - * Side effects: - * The global variable $errorCode is reset. - * - *---------------------------------------------------------------------- - */ - -char * -Tcl_PosixError(interp) - Tcl_Interp *interp; /* Interpreter whose $errorCode variable - * is to be changed. */ -{ - char *id, *msg; - - msg = Tcl_ErrnoMsg(errno); - id = Tcl_ErrnoId(); - Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL); - return msg; -} - -/* - *---------------------------------------------------------------------- - * - * TclStat -- - * - * This procedure replaces the library version of stat and lsat. - * The chain of functions that have been "inserted" into the - * 'statProcList' will be called in succession until either - * a value of zero is returned, or the entire list is visited. - * - * Results: - * See stat documentation. - * - * Side effects: - * See stat documentation. - * - *---------------------------------------------------------------------- - */ - -int -TclStat(path, buf) - CONST char *path; /* Path of file to stat (in current CP). */ - TclStat_ *buf; /* Filled with results of stat call. */ -{ - StatProc *statProcPtr; - int retVal = -1; - - /* - * Call each of the "stat" function in succession. A non-return - * value of -1 indicates the particular function has succeeded. - */ - - Tcl_MutexLock(&hookMutex); - statProcPtr = statProcList; - while ((retVal == -1) && (statProcPtr != NULL)) { - retVal = (*statProcPtr->proc)(path, buf); - statProcPtr = statProcPtr->nextPtr; - } - Tcl_MutexUnlock(&hookMutex); - - return (retVal); -} - -/* - *---------------------------------------------------------------------- - * - * TclAccess -- - * - * This procedure replaces the library version of access. - * The chain of functions that have been "inserted" into the - * 'accessProcList' will be called in succession until either - * a value of zero is returned, or the entire list is visited. - * - * Results: - * See access documentation. - * - * Side effects: - * See access documentation. - * - *---------------------------------------------------------------------- - */ - -int -TclAccess(path, mode) - CONST char *path; /* Path of file to access (in current CP). */ - int mode; /* Permission setting. */ -{ - AccessProc *accessProcPtr; - int retVal = -1; - - /* - * Call each of the "access" function in succession. A non-return - * value of -1 indicates the particular function has succeeded. - */ - - Tcl_MutexLock(&hookMutex); - accessProcPtr = accessProcList; - while ((retVal == -1) && (accessProcPtr != NULL)) { - retVal = (*accessProcPtr->proc)(path, mode); - accessProcPtr = accessProcPtr->nextPtr; - } - Tcl_MutexUnlock(&hookMutex); - - return (retVal); -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_OpenFileChannel -- - * - * The chain of functions that have been "inserted" into the - * 'openFileChannelProcList' will be called in succession until - * either a valid file channel is returned, or the entire list is - * visited. - * - * Results: - * The new channel or NULL, if the named file could not be opened. - * - * Side effects: - * May open the channel and may cause creation of a file on the - * file system. - * - *---------------------------------------------------------------------- - */ - -Tcl_Channel -Tcl_OpenFileChannel(interp, fileName, modeString, permissions) - Tcl_Interp *interp; /* Interpreter for error reporting; - * can be NULL. */ - char *fileName; /* Name of file to open. */ - char *modeString; /* A list of POSIX open modes or - * a string such as "rw". */ - int permissions; /* If the open involves creating a - * file, with what modes to create - * it? */ -{ - OpenFileChannelProc *openFileChannelProcPtr; - Tcl_Channel retVal = NULL; - - /* - * Call each of the "Tcl_OpenFileChannel" function in succession. - * A non-NULL return value indicates the particular function has - * succeeded. - */ - - Tcl_MutexLock(&hookMutex); - openFileChannelProcPtr = openFileChannelProcList; - while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) { - retVal = (*openFileChannelProcPtr->proc)(interp, fileName, - modeString, permissions); - openFileChannelProcPtr = openFileChannelProcPtr->nextPtr; - } - Tcl_MutexUnlock(&hookMutex); - - return (retVal); -} - -/* - *---------------------------------------------------------------------- - * - * TclStatInsertProc -- - * - * Insert the passed procedure pointer at the head of the list of - * functions which are used during a call to 'TclStat(...)'. The - * passed function should be have exactly like 'TclStat' when called - * during that time (see 'TclStat(...)' for more informatin). - * The function will be added even if it already in the list. - * - * Results: - * Normally TCL_OK; TCL_ERROR if memory for a new node in the list - * could not be allocated. - * - * Side effects: - * Memory allocataed and modifies the link list for 'TclStat' - * functions. - * - *---------------------------------------------------------------------- - */ - -int -TclStatInsertProc (proc) - TclStatProc_ *proc; -{ - int retVal = TCL_ERROR; - - if (proc != NULL) { - StatProc *newStatProcPtr; - - newStatProcPtr = (StatProc *)Tcl_Alloc(sizeof(StatProc));; - - if (newStatProcPtr != NULL) { - newStatProcPtr->proc = proc; - Tcl_MutexLock(&hookMutex); - newStatProcPtr->nextPtr = statProcList; - statProcList = newStatProcPtr; - Tcl_MutexUnlock(&hookMutex); - - retVal = TCL_OK; - } - } - - return (retVal); -} - -/* - *---------------------------------------------------------------------- - * - * TclStatDeleteProc -- - * - * Removed the passed function pointer from the list of 'TclStat' - * functions. Ensures that the built-in stat function is not - * removvable. - * - * Results: - * TCL_OK if the procedure pointer was successfully removed, - * TCL_ERROR otherwise. - * - * Side effects: - * Memory is deallocated and the respective list updated. - * - *---------------------------------------------------------------------- - */ - -int -TclStatDeleteProc (proc) - TclStatProc_ *proc; -{ - int retVal = TCL_ERROR; - StatProc *tmpStatProcPtr; - StatProc *prevStatProcPtr = NULL; - - Tcl_MutexLock(&hookMutex); - tmpStatProcPtr = statProcList; - /* - * Traverse the 'statProcList' looking for the particular node - * whose 'proc' member matches 'proc' and remove that one from - * the list. Ensure that the "default" node cannot be removed. - */ - - while ((retVal == TCL_ERROR) && (tmpStatProcPtr != &defaultStatProc)) { - if (tmpStatProcPtr->proc == proc) { - if (prevStatProcPtr == NULL) { - statProcList = tmpStatProcPtr->nextPtr; - } else { - prevStatProcPtr->nextPtr = tmpStatProcPtr->nextPtr; - } - - Tcl_Free((char *)tmpStatProcPtr); - - retVal = TCL_OK; - } else { - prevStatProcPtr = tmpStatProcPtr; - tmpStatProcPtr = tmpStatProcPtr->nextPtr; - } - } - - Tcl_MutexUnlock(&hookMutex); - return (retVal); -} - -/* - *---------------------------------------------------------------------- - * - * TclAccessInsertProc -- - * - * Insert the passed procedure pointer at the head of the list of - * functions which are used during a call to 'TclAccess(...)'. The - * passed function should be have exactly like 'TclAccess' when - * called during that time (see 'TclAccess(...)' for more informatin). - * The function will be added even if it already in the list. - * - * Results: - * Normally TCL_OK; TCL_ERROR if memory for a new node in the list - * could not be allocated. - * - * Side effects: - * Memory allocataed and modifies the link list for 'TclAccess' - * functions. - * - *---------------------------------------------------------------------- - */ - -int -TclAccessInsertProc(proc) - TclAccessProc_ *proc; -{ - int retVal = TCL_ERROR; - - if (proc != NULL) { - AccessProc *newAccessProcPtr; - - newAccessProcPtr = (AccessProc *)Tcl_Alloc(sizeof(AccessProc));; - - if (newAccessProcPtr != NULL) { - newAccessProcPtr->proc = proc; - Tcl_MutexLock(&hookMutex); - newAccessProcPtr->nextPtr = accessProcList; - accessProcList = newAccessProcPtr; - Tcl_MutexUnlock(&hookMutex); - - retVal = TCL_OK; - } - } - - return (retVal); -} - -/* - *---------------------------------------------------------------------- - * - * TclAccessDeleteProc -- - * - * Removed the passed function pointer from the list of 'TclAccess' - * functions. Ensures that the built-in access function is not - * removvable. - * - * Results: - * TCL_OK if the procedure pointer was successfully removed, - * TCL_ERROR otherwise. - * - * Side effects: - * Memory is deallocated and the respective list updated. - * - *---------------------------------------------------------------------- - */ - -int -TclAccessDeleteProc(proc) - TclAccessProc_ *proc; -{ - int retVal = TCL_ERROR; - AccessProc *tmpAccessProcPtr; - AccessProc *prevAccessProcPtr = NULL; - - /* - * Traverse the 'accessProcList' looking for the particular node - * whose 'proc' member matches 'proc' and remove that one from - * the list. Ensure that the "default" node cannot be removed. - */ - - Tcl_MutexLock(&hookMutex); - tmpAccessProcPtr = accessProcList; - while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != &defaultAccessProc)) { - if (tmpAccessProcPtr->proc == proc) { - if (prevAccessProcPtr == NULL) { - accessProcList = tmpAccessProcPtr->nextPtr; - } else { - prevAccessProcPtr->nextPtr = tmpAccessProcPtr->nextPtr; - } - - Tcl_Free((char *)tmpAccessProcPtr); - - retVal = TCL_OK; - } else { - prevAccessProcPtr = tmpAccessProcPtr; - tmpAccessProcPtr = tmpAccessProcPtr->nextPtr; - } - } - Tcl_MutexUnlock(&hookMutex); - - return (retVal); -} - -/* - *---------------------------------------------------------------------- - * - * TclOpenFileChannelInsertProc -- - * - * Insert the passed procedure pointer at the head of the list of - * functions which are used during a call to - * 'Tcl_OpenFileChannel(...)'. The passed function should be have - * exactly like 'Tcl_OpenFileChannel' when called during that time - * (see 'Tcl_OpenFileChannel(...)' for more informatin). The - * function will be added even if it already in the list. - * - * Results: - * Normally TCL_OK; TCL_ERROR if memory for a new node in the list - * could not be allocated. - * - * Side effects: - * Memory allocataed and modifies the link list for - * 'Tcl_OpenFileChannel' functions. - * - *---------------------------------------------------------------------- - */ - -int -TclOpenFileChannelInsertProc(proc) - TclOpenFileChannelProc_ *proc; -{ - int retVal = TCL_ERROR; - - if (proc != NULL) { - OpenFileChannelProc *newOpenFileChannelProcPtr; - - newOpenFileChannelProcPtr = - (OpenFileChannelProc *)Tcl_Alloc(sizeof(OpenFileChannelProc));; - - if (newOpenFileChannelProcPtr != NULL) { - newOpenFileChannelProcPtr->proc = proc; - Tcl_MutexLock(&hookMutex); - newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList; - openFileChannelProcList = newOpenFileChannelProcPtr; - Tcl_MutexUnlock(&hookMutex); - - retVal = TCL_OK; - } - } - - return (retVal); -} - -/* - *---------------------------------------------------------------------- - * - * TclOpenFileChannelDeleteProc -- - * - * Removed the passed function pointer from the list of - * 'Tcl_OpenFileChannel' functions. Ensures that the built-in - * open file channel function is not removvable. - * - * Results: - * TCL_OK if the procedure pointer was successfully removed, - * TCL_ERROR otherwise. - * - * Side effects: - * Memory is deallocated and the respective list updated. - * - *---------------------------------------------------------------------- - */ - -int -TclOpenFileChannelDeleteProc(proc) - TclOpenFileChannelProc_ *proc; -{ - int retVal = TCL_ERROR; - OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList; - OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL; - - /* - * Traverse the 'openFileChannelProcList' looking for the particular - * node whose 'proc' member matches 'proc' and remove that one from - * the list. Ensure that the "default" node cannot be removed. - */ - - Tcl_MutexLock(&hookMutex); - tmpOpenFileChannelProcPtr = openFileChannelProcList; - while ((retVal == TCL_ERROR) && - (tmpOpenFileChannelProcPtr != &defaultOpenFileChannelProc)) { - if (tmpOpenFileChannelProcPtr->proc == proc) { - if (prevOpenFileChannelProcPtr == NULL) { - openFileChannelProcList = tmpOpenFileChannelProcPtr->nextPtr; - } else { - prevOpenFileChannelProcPtr->nextPtr = - tmpOpenFileChannelProcPtr->nextPtr; - } - - Tcl_Free((char *)tmpOpenFileChannelProcPtr); - - retVal = TCL_OK; - } else { - prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr; - tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr; - } - } - Tcl_MutexUnlock(&hookMutex); - - return (retVal); -} |