tclioutil.c

tcl是工具命令语言

/* 
 * Define the tail of the linked list.  Note that for unconventional
 * uses of Tcl without a native filesystem, we may in the future wish
 * to modify the current approach of hard-coding the native filesystem
 * in the lookup list 'filesystemList' below.
 * 
 * We initialize the record so that it thinks one file uses it.  This
 * means it will never be freed.
 */
static FilesystemRecord nativeFilesystemRecord = {
    NULL,
    &tclNativeFilesystem,
    1,
    NULL
};

/* 
 * The following few variables are protected by the 
 * filesystemMutex just below.
 */

/* 
 * This is incremented each time we modify the linked list of
 * filesystems.  Any time it changes, all cached filesystem
 * representations are suspect and must be freed.
 */
static int theFilesystemEpoch = 0;

/*
 * Stores the linked list of filesystems.
 */
static FilesystemRecord *filesystemList = &nativeFilesystemRecord;

/* 
 * The number of loops which are currently iterating over the linked
 * list.  If this is greater than zero, we can't modify the list.
 */
static int filesystemIteratorsInProgress = 0;

/*
 * Someone wants to modify the list of filesystems if this is set.
 */
static int filesystemWantToModify = 0;

#ifdef TCL_THREADS
static Tcl_Condition filesystemOkToModify = NULL;
#endif

TCL_DECLARE_MUTEX(filesystemMutex)

/* 
 * struct FsPath --
 * 
 * Internal representation of a Tcl_Obj of "path" type.  This
 * can be used to represent relative or absolute paths, and has
 * certain optimisations when used to represent paths which are
 * already normalized and absolute.
 * 
 * Note that 'normPathPtr' can be a circular reference to the
 * container Tcl_Obj of this FsPath.
 */
typedef struct FsPath {
    Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences.
                                 * If this is NULL, then this is a 
                                 * pure normalized, absolute path
                                 * object, in which the parent Tcl_Obj's
                                 * string rep is already both translated
                                 * and normalized. */
    Tcl_Obj *normPathPtr;       /* Normalized absolute path, without 
                                 * ., .. or ~user sequences. If the 
                                 * Tcl_Obj containing 
				 * this FsPath is already normalized, 
				 * this may be a circular reference back
				 * to the container.  If that is NOT the
				 * case, we have a refCount on the object. */
    Tcl_Obj *cwdPtr;            /* If null, path is absolute, else
                                 * this points to the cwd object used
				 * for this path.  We have a refCount
				 * on the object. */
    int flags;                  /* Flags to describe interpretation */
    ClientData nativePathPtr;   /* Native representation of this path,
                                 * which is filesystem dependent. */
    int filesystemEpoch;        /* Used to ensure the path representation
                                 * was generated during the correct
				 * filesystem epoch.  The epoch changes
				 * when filesystem-mounts are changed. */ 
    struct FilesystemRecord *fsRecPtr;
                                /* Pointer to the filesystem record 
                                 * entry to use for this path. */
} FsPath;

#define TCLPATH_APPENDED 1
#define TCLPATH_RELATIVE 2
/* 
 * Used to implement Tcl_FSGetCwd in a file-system independent way.
 * This is protected by the cwdMutex below.
 */
static Tcl_Obj* cwdPathPtr = NULL;
TCL_DECLARE_MUTEX(cwdMutex)

/* 
 * Declare fallback support function and 
 * information for Tcl_FSLoadFile 
 */
static Tcl_FSUnloadFileProc FSUnloadTempFile;

/*
 * One of these structures is used each time we successfully load a
 * file from a file system by way of making a temporary copy of the
 * file on the native filesystem.  We need to store both the actual
 * unloadProc/clientData combination which was used, and the original
 * and modified filenames, so that we can correctly undo the entire
 * operation when we want to unload the code.
 */
typedef struct FsDivertLoad {
    Tcl_LoadHandle loadHandle;
    Tcl_FSUnloadFileProc *unloadProcPtr;	
    Tcl_Obj *divertedFile;
    Tcl_Filesystem *divertedFilesystem;
    ClientData divertedFileNativeRep;
} FsDivertLoad;

/* Now move on to the basic filesystem implementation */


static int 
FsCwdPointerEquals(objPtr)
    Tcl_Obj* objPtr;
{
    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr == objPtr) {
	Tcl_MutexUnlock(&cwdMutex);
	return 1;
    } else {
	Tcl_MutexUnlock(&cwdMutex);
	return 0;
    }
}
        

static FilesystemRecord* 
FsGetIterator(void) {
    Tcl_MutexLock(&filesystemMutex);
    filesystemIteratorsInProgress++;
    Tcl_MutexUnlock(&filesystemMutex);
    /* Now we know the list of filesystems cannot be modified */
    return filesystemList;
}

static void 
FsReleaseIterator(void) {
    Tcl_MutexLock(&filesystemMutex);
    filesystemIteratorsInProgress--;
    if (filesystemIteratorsInProgress == 0) {
        /* Notify any waiting threads that things are ok now */
	if (filesystemWantToModify > 0) {
	    Tcl_ConditionNotify(&filesystemOkToModify);
	}
    }
    Tcl_MutexUnlock(&filesystemMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeFilesystem --
 *
 *	Clean up the filesystem.  After this, calls to all Tcl_FS...
 *	functions will fail.
 *	
 *	We will later call TclResetFilesystem to restore the FS
 *	to a pristine state.
 *	
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees any memory allocated by the filesystem.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeFilesystem()
{
    /* 
     * Assumption that only one thread is active now.  Otherwise
     * we would need to put various mutexes around this code.
     */
    
    if (cwdPathPtr != NULL) {
	Tcl_DecrRefCount(cwdPathPtr);
	cwdPathPtr = NULL;
    }

    /* 
     * Remove all filesystems, freeing any allocated memory
     * that is no longer needed
     */
    while (filesystemList != NULL) {
	FilesystemRecord *tmpFsRecPtr = filesystemList->nextPtr;
	if (filesystemList->fileRefCount > 0) {
	    /* 
	     * This filesystem must have some path objects still
	     * around which will be freed later (e.g. when unloading
	     * any shared libraries).  If not, then someone is
	     * causing us to leak memory.
	     */
	} else {
	    /* The native filesystem is static, so we don't free it */
	    if (filesystemList != &nativeFilesystemRecord) {
		ckfree((char *)filesystemList);
	    }
	}
	filesystemList = tmpFsRecPtr;
    }
    /*
     * Now filesystemList is NULL.  This means that any attempt
     * to use the filesystem is likely to fail.
     */
    statProcList = NULL;
    accessProcList = NULL;
    openFileChannelProcList = NULL;
#ifdef __WIN32__
    TclWinEncodingsCleanup();
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclResetFilesystem --
 *
 *	Restore the filesystem to a pristine state.
 *	
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclResetFilesystem()
{
    filesystemList = &nativeFilesystemRecord;
    /* 
     * Note, at this point, I believe nativeFilesystemRecord ->
     * fileRefCount should equal 1 and if not, we should try to track
     * down the cause.
     */
    
    filesystemIteratorsInProgress = 0;
    filesystemWantToModify = 0;
#ifdef TCL_THREADS
    filesystemOkToModify = NULL;
#endif
#ifdef __WIN32__
    /* 
     * Cleans up the win32 API filesystem proc lookup table. This must
     * happen very late in finalization so that deleting of copied
     * dlls can occur.
     */
    TclWinResetInterfaces();
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSRegister --
 *
 *    Insert the filesystem function table at the head of the list of
 *    functions which are used during calls to all file-system
 *    operations.  The filesystem will be added even if it is 
 *    already in the list.  (You can use Tcl_FSData to
 *    check if it is in the list, provided the ClientData used was
 *    not NULL).
 *    
 *    Note that the filesystem handling is head-to-tail of the list.
 *    Each filesystem is asked in turn whether it can handle a
 *    particular request, _until_ one of them says 'yes'. At that
 *    point no further filesystems are asked.
 *    
 *    In particular this means if you want to add a diagnostic
 *    filesystem (which simply reports all fs activity), it must be 
 *    at the head of the list: i.e. it must be the last registered.
 *
 * Results:
 *    Normally TCL_OK; TCL_ERROR if memory for a new node in the list
 *    could not be allocated.
 *
 * Side effects:
 *    Memory allocated and modifies the link list for filesystems.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSRegister(clientData, fsPtr)
    ClientData clientData;    /* Client specific data for this fs */
    Tcl_Filesystem  *fsPtr;   /* The filesystem record for the new fs. */
{
    FilesystemRecord *newFilesystemPtr;

    if (fsPtr == NULL) {
	return TCL_ERROR;
    }

    newFilesystemPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));

    newFilesystemPtr->clientData = clientData;
    newFilesystemPtr->fsPtr = fsPtr;
    /* 
     * We start with a refCount of 1.  If this drops to zero, then
     * anyone is welcome to ckfree us.
     */
    newFilesystemPtr->fileRefCount = 1;

    /* 
     * Is this lock and wait strictly speaking necessary?  Since any
     * iterators out there will have grabbed a copy of the head of
     * the list and be iterating away from that, if we add a new
     * element to the head of the list, it can't possibly have any
     * effect on any of their loops.  In fact it could be better not
     * to wait, since we are adjusting the filesystem epoch, any
     * cached representations calculated by existing iterators are
     * going to have to be thrown away anyway.
     * 
     * However, since registering and unregistering filesystems is
     * a very rare action, this is not a very important point.
     */
    Tcl_MutexLock(&filesystemMutex);
    if (filesystemIteratorsInProgress) {
	filesystemWantToModify++;
	Tcl_ConditionWait(&filesystemOkToModify, &filesystemMutex, NULL);
	filesystemWantToModify--;
    }

    newFilesystemPtr->nextPtr = filesystemList;
    filesystemList = newFilesystemPtr;
    /* 
     * Increment the filesystem epoch counter, since existing paths
     * might conceivably now belong to different filesystems.
     */
    theFilesystemEpoch++;
    Tcl_MutexUnlock(&filesystemMutex);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSUnregister --
 *
 *    Remove the passed filesystem from the list of filesystem
 *    function tables.  It also ensures that the built-in
 *    (native) filesystem is not removable, although we may wish
 *    to change that decision in the future to allow a smaller
 *    Tcl core, in which the native filesystem is not used at
 *    all (we could, say, initialise Tcl completely over a network
 *    connection).
 *
 * Results:
 *    TCL_OK if the procedure pointer was successfully removed,
 *    TCL_ERROR otherwise.
 *
 * Side effects:
 *    Memory may be deallocated (or will be later, once no "path" 
 *    objects refer to this filesystem), but the list of registered
 *    filesystems is updated immediately.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSUnregister(fsPtr)
    Tcl_Filesystem  *fsPtr;   /* The filesystem record to remove. */
{
    int retVal = TCL_ERROR;
    FilesystemRecord *tmpFsRecPtr;
    FilesystemRecord *prevFsRecPtr = NULL;

    Tcl_MutexLock(&filesystemMutex);
    if (filesystemIteratorsInProgress) {
	filesystemWantToModify++;
	Tcl_ConditionWait(&filesystemOkToModify, &filesystemMutex, NULL);
	filesystemWantToModify--;
    }
    tmpFsRecPtr = filesystemList;
    /*
     * Traverse the 'filesystemList' looking for the particular node
     * whose 'fsPtr' member matches 'fsPtr' and remove that one from
     * the list.  Ensure that the "default" node cannot be removed.
     */

    while ((retVal == TCL_ERROR) && (tmpFsRecPtr != &nativeFilesystemRecord)) {
	if (tmpFsRecPtr->fsPtr == fsPtr) {
	    if (prevFsRecPtr == NULL) {
		filesystemList = filesystemList->nextPtr;
	    } else {
		prevFsRecPtr->nextPtr = tmpFsRecPtr->nextPtr;
	    }
	    /* 
	     * Increment the filesystem epoch counter, since existing
	     * paths might conceivably now belong to different
	     * filesystems.  This should also ensure that paths which
	     * have cached the filesystem which is about to be deleted
	     * do not reference that filesystem (which would of course
	     * lead to memory exceptions).
	     */
	    theFilesystemEpoch++;
	    
	    tmpFsRecPtr->fileRefCount--;
	    if (tmpFsRecPtr->fileRefCount <= 0) {
	        ckfree((char *)tmpFsRecPtr);
	    }