Tcl Source Code

		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"jump table must have 64-bit integer keys",
			TCL_AUTO_LENGTH));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLEENTRY", (char *)NULL);
	    }
	    goto error;
	}
	hPtr = Tcl_CreateHashEntry(&jtnPtr->hashTable, INT2PTR(key), &isNew);
	if (!isNew) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"duplicate entry in jump table for \"%s\"",
			TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY", (char *)NULL);
	    }

	JumptableNumInfo *jtnPtr = (JumptableNumInfo *)
		codePtr->auxDataArrayPtr[tblIdx].clientData;
	TRACE(("%u \"%.20s\" => ", tblIdx, O2S(OBJ_AT_TOS)));
	Tcl_WideInt key;
	if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &key) != TCL_OK) {
	    goto jumpTableNumFallthrough;
	}
	hPtr = Tcl_FindHashEntry(&jtnPtr->hashTable, INT2PTR(key));

    processJumpTableEntry:
	if (hPtr != NULL) {
	    Tcl_Size jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr));

	    TRACE_APPEND(("found in table, new pc %" SIZEu "\n",
		    PC_REL + jumpOffset));

	Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	if (normDirName == NULL) {
	    /* Not really true, but what else to do? */
	    Tcl_SetErrno(ENOENT);
	    return -1;
	}
	if (normDirName != pathPtr) { Tcl_IncrRefCount(normDirName); }

	if (fsPtr == &tclNativeFilesystem) {
	    void *cd;
	    void *oldcd = tsdPtr->cwdClientData;

	    /*
	     * Assume that the native filesystem has a getCwdProc and that it

	    /*
	     * The filesystem of the current directory is not the same as the
	     * filesystem of the previous current directory.  Invalidate All
	     * FsPath objects.
	     */
	    Tcl_FSMountsChanged(NULL);
	}
	if (normDirName != pathPtr) { Tcl_DecrRefCount(normDirName); }
    } else {
	/*
	 * The current directory is now changed or an error occurred and an
	 * error message is now set. Just continue.
	 */
    }

 * For password rotation.
 */

static const char pwrot[17] =
    "\x00\x80\x40\xC0\x20\xA0\x60\xE0"
    "\x10\x90\x50\xD0\x30\xB0\x70\xF0";

static int zipfs_tcl_library_init = 0;
static const char *zipfs_literal_tcl_library = NULL;

/* Function prototypes */

static int		CopyImageFile(Tcl_Interp *interp, const char *imgName,
			    Tcl_Channel out);
static int		DescribeMounted(Tcl_Interp *interp,

	    Tcl_FSJoinToPath(libDirObj, 1, &subDirObj));
    Tcl_DecrRefCount(subDirObj);
    Tcl_IncrRefCount(searchPathObj);
    Tcl_SetEncodingSearchPath(searchPathObj);
    Tcl_DecrRefCount(searchPathObj);
    /* Bug [fccb9f322f]. Reinit system encoding after setting search path */
    TclpSetInitialEncodings();
    zipfs_tcl_library_init = 1;
    return libDirObj;
}

Tcl_Obj *
TclZipfs_TclLibrary(void)
{
    Tcl_Obj *vfsInitScript;
    int found;
#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(STATIC_BUILD)
#   define LIBRARY_SIZE	    64
    HMODULE hModule;
    WCHAR wName[MAX_PATH + LIBRARY_SIZE];
    char dllName[(MAX_PATH + LIBRARY_SIZE) * 3];
#endif /* _WIN32 */

    /*
     * Use the cached value if that has been set; we don't want to repeat the
     * searching and mounting. Even if it is not found, see [62019f8aa9f5ec73].
     */
    
    if (zipfs_tcl_library_init) {
	if (!zipfs_literal_tcl_library) {
	    return NULL;
	}
	return ScriptLibrarySetup(zipfs_literal_tcl_library);
    }

    /*
     * Look for the library file system within the executable.
     */

     * If anything set the cache (but subsequently failed) go with that
     * anyway.
     */

    if (zipfs_literal_tcl_library) {
	return ScriptLibrarySetup(zipfs_literal_tcl_library);
    }
    /* 
     * No zipfs tcl-library, mark it to avoid performance penalty [62019f8aa9f5ec73],
     * by future calls (child interpreters, threads, etc).
     */
    zipfs_tcl_library_init = 1;
    return NULL;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSTclLibraryObjCmd --

	DEPARG='"$(shell $(CYGPATH) $<)"'
    fi

    # set various compiler flags depending on whether we are using gcc or cl

    if test "${GCC}" = "yes" ; then
	extra_cflags="-pipe"
	extra_ldflags="-pipe -static-libgcc"
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for mingw32 version of gcc" >&5
printf %s "checking for mingw32 version of gcc... " >&6; }
if test ${ac_cv_win32+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext

printf "%s\n" "$ac_cv_nolto" >&6; }
	CFLAGS=$hold_cflags
	if test "$ac_cv_nolto" = "yes" ; then
	    CFLAGS_NOLTO="-fno-lto"
	else
	    CFLAGS_NOLTO=""
	fi

	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if the linker understands --disable-high-entropy-va" >&5
printf %s "checking if the linker understands --disable-high-entropy-va... " >&6; }
if test ${tcl_cv_ld_high_entropy+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e)
	    hold_cflags=$CFLAGS; CFLAGS="$CFLAGS  -Wl,--disable-high-entropy-va"
	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_ld_high_entropy=yes
else case e in #(
  e) tcl_cv_ld_high_entropy=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    conftest$ac_exeext conftest.$ac_ext
	    CFLAGS=$hold_cflags ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_high_entropy" >&5
printf "%s\n" "$tcl_cv_ld_high_entropy" >&6; }
	if test $tcl_cv_ld_high_entropy = yes; then
	    extra_ldflags="$extra_ldflags -Wl,--disable-high-entropy-va"
	fi

	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -finput-charset" >&5
printf %s "checking if the compiler understands -finput-charset... " >&6; }
if test ${tcl_cv_cc_input_charset+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e)

main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"
then :
  ac_cv_enable_auto_image_base=yes
else case e in #(
  e) ac_cv_enable_auto_image_base=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    conftest$ac_exeext conftest.$ac_ext
     ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_enable_auto_image_base" >&5
printf "%s\n" "$ac_cv_enable_auto_image_base" >&6; }
    CFLAGS=$hold_cflags
    if test "$ac_cv_enable_auto_image_base" = "yes" ; then

	DEPARG='"$(shell $(CYGPATH) $<)"'
    fi

    # set various compiler flags depending on whether we are using gcc or cl

    if test "${GCC}" = "yes" ; then
	extra_cflags="-pipe"
	extra_ldflags="-pipe -static-libgcc"
	AC_CACHE_CHECK(for mingw32 version of gcc,
	    ac_cv_win32,
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		#ifdef _WIN32
		    #error win32
		#endif
	    ]], [[]])],

	)
	CFLAGS=$hold_cflags
	if test "$ac_cv_nolto" = "yes" ; then
	    CFLAGS_NOLTO="-fno-lto"
	else
	    CFLAGS_NOLTO=""
	fi

	AC_CACHE_CHECK([if the linker understands --disable-high-entropy-va],
	    tcl_cv_ld_high_entropy, [
	    hold_cflags=$CFLAGS; CFLAGS="$CFLAGS  -Wl,--disable-high-entropy-va"
	    AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_ld_high_entropy=yes],[tcl_cv_ld_high_entropy=no])
	    CFLAGS=$hold_cflags])
	if test $tcl_cv_ld_high_entropy = yes; then
	    extra_ldflags="$extra_ldflags -Wl,--disable-high-entropy-va"
	fi

	AC_CACHE_CHECK([if the compiler understands -finput-charset],
	    tcl_cv_cc_input_charset, [
	    hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8"
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_cc_input_charset=yes],[tcl_cv_cc_input_charset=no])
	    CFLAGS=$hold_cflags])
	if test $tcl_cv_cc_input_charset = yes; then
	    extra_cflags="$extra_cflags -finput-charset=UTF-8"
	fi
    fi

    hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--enable-auto-image-base"
    AC_CACHE_CHECK(for working --enable-auto-image-base,
	ac_cv_enable_auto_image_base,
    AC_LINK_IFELSE([AC_LANG_PROGRAM([])],
	[ac_cv_enable_auto_image_base=yes],
	[ac_cv_enable_auto_image_base=no])
    )
    CFLAGS=$hold_cflags
    if test "$ac_cv_enable_auto_image_base" = "yes" ; then
	extra_ldflags="$extra_ldflags -Wl,--enable-auto-image-base"
    fi

AC_DEFUN([SC_WITH_TCL], [
    if test -d ../../tcl9.1$1/win;  then
	TCL_BIN_DEFAULT=../../tcl9.1$1/win
    else
	TCL_BIN_DEFAULT=../../tcl9.1/win
    fi

    AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 9.x binaries from DIR],
	    TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
    if test ! -d $TCL_BIN_DIR; then
	AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
    fi
    if test ! -f $TCL_BIN_DIR/Makefile; then
	AC_MSG_ERROR(There is no Makefile in $TCL_BIN_DIR:  perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
    else

{
    Tcl_DString ds;
    Tcl_DString srcString, dstString;
    Tcl_Obj *normSrcPtr, *normDestPtr;
    int ret;

    normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr);
    if (normSrcPtr == NULL) {
	return TCL_ERROR;
    }
    if (normSrcPtr != srcPathPtr) { Tcl_IncrRefCount(normSrcPtr); }
    normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
    if (normDestPtr == NULL) {
	if (normSrcPtr != srcPathPtr) { Tcl_DecrRefCount(normSrcPtr); }
	return TCL_ERROR;
    }
    if (normDestPtr != destPathPtr) { Tcl_IncrRefCount(normDestPtr); }

    Tcl_DStringInit(&srcString);
    Tcl_DStringInit(&dstString);
    Tcl_UtfToWCharDString(TclGetString(normSrcPtr), TCL_INDEX_NONE, &srcString);
    Tcl_UtfToWCharDString(TclGetString(normDestPtr), TCL_INDEX_NONE, &dstString);

    ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);

	    *errorPtr = destPathPtr;
	} else {
	    *errorPtr = Tcl_DStringToObj(&ds);
	}
	Tcl_DStringFree(&ds);
	Tcl_IncrRefCount(*errorPtr);
    }

    if (normSrcPtr != srcPathPtr) { Tcl_DecrRefCount(normSrcPtr); }
    if (normDestPtr != destPathPtr) { Tcl_DecrRefCount(normDestPtr); }
    return ret;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpObjRemoveDirectory, DoRemoveDirectory --

	 */

	Tcl_DString native;
	normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (normPtr == NULL) {
	    return TCL_ERROR;
	}
	if (normPtr != pathPtr) { Tcl_IncrRefCount(normPtr); }
	Tcl_DStringInit(&native);
	Tcl_UtfToWCharDString(TclGetString(normPtr), TCL_INDEX_NONE, &native);
	ret = DoRemoveDirectory(&native, recursive, &ds);
	Tcl_DStringFree(&native);
    } else {
	ret = DoRemoveJustDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds);
    }

    if (ret != TCL_OK) {
	if (Tcl_DStringLength(&ds) > 0) {
	    if (normPtr != NULL &&
		    !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
		*errorPtr = pathPtr;
	    } else {
		*errorPtr = Tcl_DStringToObj(&ds);
	    }
	    Tcl_IncrRefCount(*errorPtr);
	}
	Tcl_DStringFree(&ds);
    }
    if (normPtr && normPtr != pathPtr) { Tcl_DecrRefCount(normPtr); }

    return ret;
}

static int
DoRemoveJustDirectory(
    const WCHAR *nativePath,	/* Pathname of directory to be removed

	    /*
	     * Match a single file directly.
	     */

	    DWORD attr;
	    WIN32_FILE_ATTRIBUTE_DATA data;
	    Tcl_Size len = 0;
	    const char *str;

	    if (norm != pathPtr) { Tcl_IncrRefCount(norm); }
	    str = TclGetStringFromObj(norm, &len);
	    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

	    if (GetFileAttributesExW(native,
		    GetFileExInfoStandard, &data) != TRUE) {
		if (norm != pathPtr) { Tcl_DecrRefCount(norm); }
		return TCL_OK;
	    }
	    attr = data.dwFileAttributes;

	    if (NativeMatchType(WinIsDrive(str, len), attr, native, types)) {
		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	    }
	    if (norm != pathPtr) { Tcl_DecrRefCount(norm); }
	}
	return TCL_OK;
    } else {
	DWORD attr;
	HANDLE handle;
	WIN32_FIND_DATAW data;
	const char *dirName;	/* UTF-8 dir name, later with pattern

	 * want any '~' sequences).
	 */

	fileNamePtr = Tcl_FSGetNormalizedPath(interp, pathPtr);
	if (fileNamePtr == NULL) {
	    return TCL_ERROR;
	}
	/* Ensure it'd be alive, while used. */
	if (fileNamePtr != pathPtr) { Tcl_IncrRefCount(fileNamePtr); }

	/*
	 * Verify that the specified path exists and is actually a directory.
	 */

	native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
	if (native == NULL) {
	    if (fileNamePtr != pathPtr) { Tcl_DecrRefCount(fileNamePtr); }
	    return TCL_OK;
	}
	attr = GetFileAttributesW(native);

	if ((attr == INVALID_FILE_ATTRIBUTES)
		|| ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
	    if (fileNamePtr != pathPtr) { Tcl_DecrRefCount(fileNamePtr); }
	    return TCL_OK;
	}

	/*
	 * Build up the directory name for searching, including a trailing
	 * directory separator.
	 */

	Tcl_DStringInit(&dsOrig);
	dirName = TclGetStringFromObj(fileNamePtr, &dirLength);
	Tcl_DStringAppend(&dsOrig, dirName, dirLength);

	lastChar = dirName[dirLength -1];
	if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
	    TclDStringAppendLiteral(&dsOrig, "/");
	    dirLength++;
	}
	if (fileNamePtr != pathPtr) { Tcl_DecrRefCount(fileNamePtr); }
	dirName = Tcl_DStringValue(&dsOrig);

	/*
	 * We need to check all files in the directory, so we append '*.*' to
	 * the path, unless the pattern we've been given is rather simple,
	 * when we can use that instead.
	 */

    Tcl_Obj *toPtr,
    int linkAction)
{
    if (toPtr != NULL) {
	int res;
	const WCHAR *LinkTarget;
	const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
	Tcl_Obj *normToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr);

	if (normToPtr == NULL) {
	    return NULL;
	}
	if (normToPtr != toPtr) { Tcl_IncrRefCount(normToPtr); }

	LinkTarget = (const WCHAR *)Tcl_FSGetNativePath(normToPtr);

	if (LinkSource == NULL || LinkTarget == NULL) {
	    if (normToPtr != toPtr) { Tcl_DecrRefCount(normToPtr); }
	    return NULL;
	}
	res = WinLink(LinkSource, LinkTarget, linkAction);
	if (normToPtr != toPtr) { Tcl_DecrRefCount(normToPtr); }
	if (res == 0) {
	    return toPtr;
	} else {
	    return NULL;
	}
    } else {
	const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);