Tcl Source Code

Check-in [4100db67b1]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix some gcc/MSVC (harmless) compiler warnings. Remove some unnecessary end-of-line spacing
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256: 4100db67b1aa29cb557cf1430777b1a0c3d9083d38f87195957df07c52079250
User & Date: jan.nijtmans 2019-03-07 08:00:29
Context
2019-03-07
14:12
Fix automatic pkgIndex generation for multiplatform installs check-in: b15367b890 user: apnadkarni tags: core-8-6-branch
08:31
Merge 8.6. Remove unneeded code from init.tcl check-in: 3efa92355e user: jan.nijtmans tags: core-8-branch
08:00
Fix some gcc/MSVC (harmless) compiler warnings. Remove some unnecessary end-of-line spacing check-in: 4100db67b1 user: jan.nijtmans tags: core-8-6-branch
07:58
Fix [9471e6e304]: InitWinEnv not thread safe check-in: e8d0d31e48 user: jan.nijtmans tags: core-8-6-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCmdMZ.c.

2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
....
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
....
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
....
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
....
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
....
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
....
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
....
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
	 * to be replaced.
	 */
	Tcl_SetObjResult(interp, objv[1]);
    } else {
	Tcl_Obj *resultPtr;

	/*
	 * We are re-fetching in case the string argument is same value as 
	 * an index argument, and shimmering cost us our ustring.
	 */

	ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
	end = length-1;

	if (first < 0) {
................................................................................
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_TimeRateObjCmd --
 *
 *	This object-based procedure is invoked to process the "timerate" Tcl
 *	command. 
 *	This is similar to command "time", except the execution limited by 
 *	given time (in milliseconds) instead of repetition count.
 *
 * Example:
 *	timerate {after 5} 1000 ; # equivalent for `time {after 5} [expr 1000/5]`
 *
 * Results:
 *	A standard Tcl object result.
................................................................................
int
Tcl_TimeRateObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static 
    double measureOverhead = 0; /* global measure-overhead */
    double overhead = -1;	/* given measure-overhead */
    register Tcl_Obj *objPtr;
    register int result, i;
    Tcl_Obj *calibrate = NULL, *direct = NULL;
    Tcl_WideUInt count = 0;	/* Holds repetition count */
    Tcl_WideInt  maxms  = WIDE_MIN;
				/* Maximal running time (in milliseconds) */
................................................................................
    if (calibrate) {

	/* if no time specified for the calibration */
	if (maxms == WIDE_MIN) {
	    Tcl_Obj *clobjv[6];
	    Tcl_WideInt maxCalTime = 5000;
	    double lastMeasureOverhead = measureOverhead;
	    
	    clobjv[0] = objv[0]; 
	    i = 1;
	    if (direct) {
	    	clobjv[i++] = direct;
	    }
	    clobjv[i++] = objPtr; 

	    /* reset last measurement overhead */
	    measureOverhead = (double)0;

	    /* self-call with 100 milliseconds to warm-up,
	     * before entering the calibration cycle */
	    TclNewLongObj(clobjv[i], 100);
................................................................................
	    Tcl_DecrRefCount(clobjv[i]);
	    if (result != TCL_OK) {
		return result;
	    }

	    i--;
	    clobjv[i++] = calibrate;
	    clobjv[i++] = objPtr; 

	    /* set last measurement overhead to max */
	    measureOverhead = (double)UWIDE_MAX;

	    /* calibration cycle until it'll be preciser */
	    maxms = -1000;
	    do {
................................................................................
		goto done;
	    }
	    /* force stop immediately */
	    threshold = 1;
	    maxcnt = 0;
	    result = TCL_OK;
	}
	
	/* don't check time up to threshold */
	if (--threshold > 0) continue;

	/* check stop time reached, estimate new threshold */
    #ifdef TCL_WIDE_CLICKS
	middle = TclpGetWideClicks();
    #else
................................................................................

	/* if not calibrate */
	if (!calibrate) {
	    /* minimize influence of measurement overhead */
	    if (overhead > 0) {
		/* estimate the time of overhead (microsecs) */
		Tcl_WideUInt curOverhead = overhead * count;
		if (middle > curOverhead) {
		    middle -= curOverhead;
		} else {
		    middle = 0;
		}
	    }
	} else {
	    /* calibration - obtaining new measurement overhead */
................................................................................
	    if (val < 1000)  { fmt = "%.3f"; } else
	    if (val < 10000) { fmt = "%.2f"; } else
			     { fmt = "%.1f"; };
	    objs[0] = Tcl_ObjPrintf(fmt, ((double)middle)/count);
	}

	objs[2] = Tcl_NewWideIntObj(count); /* iterations */
	
	/* calculate speed as rate (count) per sec */
	if (!middle) middle++; /* +1 ms, just to avoid divide by zero */
	if (count < (WIDE_MAX / 1000000)) {
	    val = (count * 1000000) / middle;
	    if (val < 100000) {
		if (val < 100)	{ fmt = "%.3f"; } else
		if (val < 1000) { fmt = "%.2f"; } else






|







 







|
|







 







<
|







 







|
|




|







 







|







 







|







 







|







 







|







2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
....
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
....
4293
4294
4295
4296
4297
4298
4299

4300
4301
4302
4303
4304
4305
4306
4307
....
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
....
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
....
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
....
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
....
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
	 * to be replaced.
	 */
	Tcl_SetObjResult(interp, objv[1]);
    } else {
	Tcl_Obj *resultPtr;

	/*
	 * We are re-fetching in case the string argument is same value as
	 * an index argument, and shimmering cost us our ustring.
	 */

	ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
	end = length-1;

	if (first < 0) {
................................................................................
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_TimeRateObjCmd --
 *
 *	This object-based procedure is invoked to process the "timerate" Tcl
 *	command.
 *	This is similar to command "time", except the execution limited by
 *	given time (in milliseconds) instead of repetition count.
 *
 * Example:
 *	timerate {after 5} 1000 ; # equivalent for `time {after 5} [expr 1000/5]`
 *
 * Results:
 *	A standard Tcl object result.
................................................................................
int
Tcl_TimeRateObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    static double measureOverhead = 0; /* global measure-overhead */
    double overhead = -1;	/* given measure-overhead */
    register Tcl_Obj *objPtr;
    register int result, i;
    Tcl_Obj *calibrate = NULL, *direct = NULL;
    Tcl_WideUInt count = 0;	/* Holds repetition count */
    Tcl_WideInt  maxms  = WIDE_MIN;
				/* Maximal running time (in milliseconds) */
................................................................................
    if (calibrate) {

	/* if no time specified for the calibration */
	if (maxms == WIDE_MIN) {
	    Tcl_Obj *clobjv[6];
	    Tcl_WideInt maxCalTime = 5000;
	    double lastMeasureOverhead = measureOverhead;

	    clobjv[0] = objv[0];
	    i = 1;
	    if (direct) {
	    	clobjv[i++] = direct;
	    }
	    clobjv[i++] = objPtr;

	    /* reset last measurement overhead */
	    measureOverhead = (double)0;

	    /* self-call with 100 milliseconds to warm-up,
	     * before entering the calibration cycle */
	    TclNewLongObj(clobjv[i], 100);
................................................................................
	    Tcl_DecrRefCount(clobjv[i]);
	    if (result != TCL_OK) {
		return result;
	    }

	    i--;
	    clobjv[i++] = calibrate;
	    clobjv[i++] = objPtr;

	    /* set last measurement overhead to max */
	    measureOverhead = (double)UWIDE_MAX;

	    /* calibration cycle until it'll be preciser */
	    maxms = -1000;
	    do {
................................................................................
		goto done;
	    }
	    /* force stop immediately */
	    threshold = 1;
	    maxcnt = 0;
	    result = TCL_OK;
	}

	/* don't check time up to threshold */
	if (--threshold > 0) continue;

	/* check stop time reached, estimate new threshold */
    #ifdef TCL_WIDE_CLICKS
	middle = TclpGetWideClicks();
    #else
................................................................................

	/* if not calibrate */
	if (!calibrate) {
	    /* minimize influence of measurement overhead */
	    if (overhead > 0) {
		/* estimate the time of overhead (microsecs) */
		Tcl_WideUInt curOverhead = overhead * count;
		if ((Tcl_WideUInt)middle > curOverhead) {
		    middle -= curOverhead;
		} else {
		    middle = 0;
		}
	    }
	} else {
	    /* calibration - obtaining new measurement overhead */
................................................................................
	    if (val < 1000)  { fmt = "%.3f"; } else
	    if (val < 10000) { fmt = "%.2f"; } else
			     { fmt = "%.1f"; };
	    objs[0] = Tcl_ObjPrintf(fmt, ((double)middle)/count);
	}

	objs[2] = Tcl_NewWideIntObj(count); /* iterations */

	/* calculate speed as rate (count) per sec */
	if (!middle) middle++; /* +1 ms, just to avoid divide by zero */
	if (count < (WIDE_MAX / 1000000)) {
	    val = (count * 1000000) / middle;
	    if (val < 100000) {
		if (val < 100)	{ fmt = "%.3f"; } else
		if (val < 1000) { fmt = "%.2f"; } else

Changes to unix/tclUnixTime.c.

244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclpWideClickInMicrosec --
 *
 *	This procedure return scale to convert click values from the 
 *	TclpGetWideClicks native resolution to microsecond resolution
 *	and back.
 *
 * Results:
 * 	1 click in microseconds as double.
 *
 * Side effects:






|







244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclpWideClickInMicrosec --
 *
 *	This procedure return scale to convert click values from the
 *	TclpGetWideClicks native resolution to microsecond resolution
 *	and back.
 *
 * Results:
 * 	1 click in microseconds as double.
 *
 * Side effects:

Changes to win/nmakehlp.c.

682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
...
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
...
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
...
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
    fclose(fp);
    return 0;
}
 
BOOL FileExists(LPCTSTR szPath)
{
#ifndef INVALID_FILE_ATTRIBUTES
    #define INVALID_FILE_ATTRIBUTES ((DWORD)-1) 
#endif
    DWORD pathAttr = GetFileAttributes(szPath);
    return (pathAttr != INVALID_FILE_ATTRIBUTES && 
	    !(pathAttr & FILE_ATTRIBUTE_DIRECTORY));
}
 

/*
 * QualifyPath --
 *
................................................................................
    strncpy(path, dir, dirlen);
    strncpy(path+dirlen, "\\*", 3);	/* Including terminating \0 */
    keylen = strlen(keypath);

#if 0 /* This function is not available in Visual C++ 6 */
    /*
     * Use numerics 0 -> FindExInfoStandard,
     * 1 -> FindExSearchLimitToDirectories, 
     * as these are not defined in Visual C++ 6
     */
    hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0);
#else
    hSearch = FindFirstFile(path, &finfo);
#endif
    if (hSearch == INVALID_HANDLE_VALUE)
................................................................................
	return 1; /* Not found */

    /* Loop through all subdirs checking if the keypath is under there */
    ret = 1; /* Assume not found */
    do {
	int sublen;
	/*
	 * We need to check it is a directory despite the 
	 * FindExSearchLimitToDirectories in the above call. See SDK docs
	 */
	if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0)
	    continue;
	sublen = strlen(finfo.cFileName);
	if ((dirlen+1+sublen+1+keylen+1) > sizeof(path))
	    continue;		/* Path does not fit, assume not matched */
................................................................................
 * LocateDependency --
 *
 *	Locates a dependency for a package.
 *        keypath - a relative path within the package directory
 *          that is used to confirm it is the correct directory.
 *	The search path for the package directory is currently only
 *      the parent and grandparent of the current working directory.
 *      If found, the command prints 
 *         name_DIRPATH=<full path of located directory>
 *      and returns 0. If not found, does not print anything and returns 1.
 */
static int LocateDependency(const char *keypath)
{
    int i, ret;
    static char *paths[] = {"..", "..\\..", "..\\..\\.."};
    
    for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
	ret = LocateDependencyHelper(paths[i], keypath);
	if (ret == 0)
	    return ret;
    }
    return ret;
}






|


|







 







|







 







|







 







|






|
|







682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
...
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
...
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
...
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
    fclose(fp);
    return 0;
}
 
BOOL FileExists(LPCTSTR szPath)
{
#ifndef INVALID_FILE_ATTRIBUTES
    #define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
#endif
    DWORD pathAttr = GetFileAttributes(szPath);
    return (pathAttr != INVALID_FILE_ATTRIBUTES &&
	    !(pathAttr & FILE_ATTRIBUTE_DIRECTORY));
}
 

/*
 * QualifyPath --
 *
................................................................................
    strncpy(path, dir, dirlen);
    strncpy(path+dirlen, "\\*", 3);	/* Including terminating \0 */
    keylen = strlen(keypath);

#if 0 /* This function is not available in Visual C++ 6 */
    /*
     * Use numerics 0 -> FindExInfoStandard,
     * 1 -> FindExSearchLimitToDirectories,
     * as these are not defined in Visual C++ 6
     */
    hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0);
#else
    hSearch = FindFirstFile(path, &finfo);
#endif
    if (hSearch == INVALID_HANDLE_VALUE)
................................................................................
	return 1; /* Not found */

    /* Loop through all subdirs checking if the keypath is under there */
    ret = 1; /* Assume not found */
    do {
	int sublen;
	/*
	 * We need to check it is a directory despite the
	 * FindExSearchLimitToDirectories in the above call. See SDK docs
	 */
	if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0)
	    continue;
	sublen = strlen(finfo.cFileName);
	if ((dirlen+1+sublen+1+keylen+1) > sizeof(path))
	    continue;		/* Path does not fit, assume not matched */
................................................................................
 * LocateDependency --
 *
 *	Locates a dependency for a package.
 *        keypath - a relative path within the package directory
 *          that is used to confirm it is the correct directory.
 *	The search path for the package directory is currently only
 *      the parent and grandparent of the current working directory.
 *      If found, the command prints
 *         name_DIRPATH=<full path of located directory>
 *      and returns 0. If not found, does not print anything and returns 1.
 */
static int LocateDependency(const char *keypath)
{
    int i, ret;
    static const char *paths[] = {"..", "..\\..", "..\\..\\.."};

    for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
	ret = LocateDependencyHelper(paths[i], keypath);
	if (ret == 0)
	    return ret;
    }
    return ret;
}

Changes to win/tclWinFile.c.

1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
....
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
....
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
....
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
    Tcl_DStringInit(bufferPtr);

    wDomain = NULL;
    domain = Tcl_UtfFindFirst(name, '@');
    if (domain == NULL) {
	const char *ptr;
	
	/* no domain - firstly check it's the current user */
	if ( (ptr = TclpGetUserName(&ds)) != NULL 
	  && strcasecmp(name, ptr) == 0
	) {
	    /* try safest and fastest way to get current user home */
	    ptr = TclGetEnv("HOME", &ds);
	    if (ptr != NULL) {
		Tcl_JoinPath(1, &ptr, bufferPtr);
		rc = 1;
................................................................................
	Tcl_DStringFree(&ds);
	nameLen = domain - name;
    }
    if (rc == 0) {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
	while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
	    /* 
	     * user does not exists - if domain was not specified,
	     * try again using current domain.
	     */
	    rc = 1;
	    if (domain != NULL) break;
	    /* get current domain */
	    rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain);
................................................................................
	/*
	 * File exists, nothing else to check.
	 */

	return 0;
    }

    /* 
     * If it's not a directory (assume file), do several fast checks:
     */
    if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
	/*
	 * If the attributes say this is not writable at all.  The file is a
	 * regular file (i.e., not a directory), then the file is not
	 * writable, full stop.	 For directories, the read-only bit is
................................................................................
     * in wish by default). However the subsequent GetFileInformationByHandle
     * will fail. We do a WinIsReserved to see if it is one of the special
     * names, and if successful, mock up a BY_HANDLE_FILE_INFORMATION
     * structure.
     */

    fileHandle = CreateFile(nativePath, GENERIC_READ,
	    FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, 
	    NULL, OPEN_EXISTING,
	    FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);

    if (fileHandle != INVALID_HANDLE_VALUE) {
	BY_HANDLE_FILE_INFORMATION data;

	if (GetFileInformationByHandle(fileHandle,&data) != TRUE) {






|

|







 







|







 







|







 







|







1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
....
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
....
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
....
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
    Tcl_DStringInit(bufferPtr);

    wDomain = NULL;
    domain = Tcl_UtfFindFirst(name, '@');
    if (domain == NULL) {
	const char *ptr;

	/* no domain - firstly check it's the current user */
	if ( (ptr = TclpGetUserName(&ds)) != NULL
	  && strcasecmp(name, ptr) == 0
	) {
	    /* try safest and fastest way to get current user home */
	    ptr = TclGetEnv("HOME", &ds);
	    if (ptr != NULL) {
		Tcl_JoinPath(1, &ptr, bufferPtr);
		rc = 1;
................................................................................
	Tcl_DStringFree(&ds);
	nameLen = domain - name;
    }
    if (rc == 0) {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
	while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
	    /*
	     * user does not exists - if domain was not specified,
	     * try again using current domain.
	     */
	    rc = 1;
	    if (domain != NULL) break;
	    /* get current domain */
	    rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain);
................................................................................
	/*
	 * File exists, nothing else to check.
	 */

	return 0;
    }

    /*
     * If it's not a directory (assume file), do several fast checks:
     */
    if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
	/*
	 * If the attributes say this is not writable at all.  The file is a
	 * regular file (i.e., not a directory), then the file is not
	 * writable, full stop.	 For directories, the read-only bit is
................................................................................
     * in wish by default). However the subsequent GetFileInformationByHandle
     * will fail. We do a WinIsReserved to see if it is one of the special
     * names, and if successful, mock up a BY_HANDLE_FILE_INFORMATION
     * structure.
     */

    fileHandle = CreateFile(nativePath, GENERIC_READ,
	    FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
	    NULL, OPEN_EXISTING,
	    FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);

    if (fileHandle != INVALID_HANDLE_VALUE) {
	BY_HANDLE_FILE_INFORMATION data;

	if (GetFileInformationByHandle(fileHandle,&data) != TRUE) {

Changes to win/tclWinLoad.c.

84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;

        /* 
         * Remember the first error on load attempt to be used if the
         * second load attempt below also fails.
        */
        firstError = (nativeName == NULL) ?
		ERROR_MOD_NOT_FOUND : GetLastError();

	nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds);






|







84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;

        /*
         * Remember the first error on load attempt to be used if the
         * second load attempt below also fails.
        */
        firstError = (nativeName == NULL) ?
		ERROR_MOD_NOT_FOUND : GetLastError();

	nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds);

Changes to win/tclWinTest.c.

568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
    /*
     * Apply the new ACL. Note PROTECTED_DACL_SECURITY_INFORMATION can be used
     * to remove inherited ACL (we need to overwrite the default ACL's in this case)
     */

    if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
	    (LPSTR) nativePath, SE_FILE_OBJECT, 
	    DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
	res = 0;
    }

  done:
    if (secDesc) {






|







568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
    /*
     * Apply the new ACL. Note PROTECTED_DACL_SECURITY_INFORMATION can be used
     * to remove inherited ACL (we need to overwrite the default ACL's in this case)
     */

    if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
	    (LPSTR) nativePath, SE_FILE_OBJECT,
	    DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
	res = 0;
    }

  done:
    if (secDesc) {

Changes to win/tclWinTime.c.

253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
...
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
...
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
....
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
....
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
    LARGE_INTEGER curCounter;

    if (!wideClick.initialized) {
	LARGE_INTEGER perfCounterFreq;

	/*
	 * The frequency of the performance counter is fixed at system boot and
	 * is consistent across all processors. Therefore, the frequency need 
	 * only be queried upon application initialization.
	 */
	if (QueryPerformanceFrequency(&perfCounterFreq)) {
	    wideClick.perfCounter = 1;
	    wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart;
	} else {
	    /* fallback using microseconds */
	    wideClick.perfCounter = 0;
	    wideClick.microsecsScale = 1;
	}
	
	wideClick.initialized = 1;
    }
    if (wideClick.perfCounter) {
	if (QueryPerformanceCounter(&curCounter)) {
	    return (Tcl_WideInt)curCounter.QuadPart;
	}
	/* fallback using microseconds */
................................................................................
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclpWideClickInMicrosec --
 *
 *	This procedure return scale to convert wide click values from the 
 *	TclpGetWideClicks native resolution to microsecond resolution
 *	and back.
 *
 * Results:
 * 	1 click in microseconds as double.
 *
 * Side effects:
................................................................................
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt 
TclpGetMicroseconds(void)
{
    Tcl_WideInt usecSincePosixEpoch;

    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
................................................................................
static inline Tcl_WideInt
NativeCalc100NsTicks(
    ULONGLONG fileTimeLastCall,
    LONGLONG perfCounterLastCall,
    LONGLONG curCounterFreq,
    LONGLONG curCounter
) {
    return fileTimeLastCall + 
	((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq);
}

static Tcl_WideInt
NativeGetMicroseconds(void)
{
    /*
................................................................................
      && curFileTime.QuadPart < lastFileTime.QuadPart +
      				    (timeInfo.calibrationInterv * 10000000)
    ) {
    	/* again in next one second */
	return;
    }
    QueryPerformanceCounter(&curPerfCounter);
    
    lastFileTime.QuadPart = curFileTime.QuadPart;

    /*
     * We devide by timeInfo.curCounterFreq.QuadPart in several places. That
     * value should always be positive on a correctly functioning system. But
     * it is good to be defensive about such matters. So if something goes
     * wrong and the value does goes to zero, we clear the
................................................................................
    if (tdiff > 10000000 || tdiff < -10000000) {
    	/* jump to current system time, use curent estimated frequency */
    	vt0 = curFileTime.QuadPart;
    } else {
    	/* calculate new frequency and estimate drift to the next second */
	vt1 = 20000000 + curFileTime.QuadPart;
	driftFreq = (estFreq * 20000000 / (vt1 - vt0));
	/* 
	 * Avoid too large drifts (only half of the current difference),
	 * that allows also be more accurate (aspire to the smallest tdiff),
	 * so then we can prolong calibration interval by tdiff < 100000
	 */
	driftFreq = timeInfo.curCounterFreq.QuadPart +
		(driftFreq - timeInfo.curCounterFreq.QuadPart) / 2;

	/* 
	 * Average between estimated, 2 current and 5 drifted frequencies,
	 * (do the soft drifting as possible)
	 */
	estFreq = (estFreq + 2 * timeInfo.curCounterFreq.QuadPart + 5 * driftFreq) / 8;
    }
    
    /* Avoid too large discrepancy from nominal frequency */
    if (estFreq > 1003*timeInfo.nominalFreq.QuadPart/1000) {
	estFreq = 1003*timeInfo.nominalFreq.QuadPart/1000;
	vt0 = curFileTime.QuadPart;
    } else if (estFreq < 997*timeInfo.nominalFreq.QuadPart/1000) {
	estFreq = 997*timeInfo.nominalFreq.QuadPart/1000;
	vt0 = curFileTime.QuadPart;
    } else if (vt0 != curFileTime.QuadPart) {
	/* 
	 * Be sure the clock ticks never backwards (avoid it by negative drifting)
	 * just compare native time (in 100-ns) before and hereafter using 
	 * new calibrated values) and do a small adjustment (short time freeze)
	 */
	LARGE_INTEGER newPerfCounter;
	Tcl_WideInt nt0, nt1;

	QueryPerformanceCounter(&newPerfCounter);
	nt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart,






|










|







 







|







 







|







 







|







 







|







 







|







|





|








|

|







253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
...
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
...
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
....
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
....
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
    LARGE_INTEGER curCounter;

    if (!wideClick.initialized) {
	LARGE_INTEGER perfCounterFreq;

	/*
	 * The frequency of the performance counter is fixed at system boot and
	 * is consistent across all processors. Therefore, the frequency need
	 * only be queried upon application initialization.
	 */
	if (QueryPerformanceFrequency(&perfCounterFreq)) {
	    wideClick.perfCounter = 1;
	    wideClick.microsecsScale = 1000000.0 / perfCounterFreq.QuadPart;
	} else {
	    /* fallback using microseconds */
	    wideClick.perfCounter = 0;
	    wideClick.microsecsScale = 1;
	}

	wideClick.initialized = 1;
    }
    if (wideClick.perfCounter) {
	if (QueryPerformanceCounter(&curCounter)) {
	    return (Tcl_WideInt)curCounter.QuadPart;
	}
	/* fallback using microseconds */
................................................................................
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclpWideClickInMicrosec --
 *
 *	This procedure return scale to convert wide click values from the
 *	TclpGetWideClicks native resolution to microsecond resolution
 *	and back.
 *
 * Results:
 * 	1 click in microseconds as double.
 *
 * Side effects:
................................................................................
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
TclpGetMicroseconds(void)
{
    Tcl_WideInt usecSincePosixEpoch;

    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
................................................................................
static inline Tcl_WideInt
NativeCalc100NsTicks(
    ULONGLONG fileTimeLastCall,
    LONGLONG perfCounterLastCall,
    LONGLONG curCounterFreq,
    LONGLONG curCounter
) {
    return fileTimeLastCall +
	((curCounter - perfCounterLastCall) * 10000000 / curCounterFreq);
}

static Tcl_WideInt
NativeGetMicroseconds(void)
{
    /*
................................................................................
      && curFileTime.QuadPart < lastFileTime.QuadPart +
      				    (timeInfo.calibrationInterv * 10000000)
    ) {
    	/* again in next one second */
	return;
    }
    QueryPerformanceCounter(&curPerfCounter);

    lastFileTime.QuadPart = curFileTime.QuadPart;

    /*
     * We devide by timeInfo.curCounterFreq.QuadPart in several places. That
     * value should always be positive on a correctly functioning system. But
     * it is good to be defensive about such matters. So if something goes
     * wrong and the value does goes to zero, we clear the
................................................................................
    if (tdiff > 10000000 || tdiff < -10000000) {
    	/* jump to current system time, use curent estimated frequency */
    	vt0 = curFileTime.QuadPart;
    } else {
    	/* calculate new frequency and estimate drift to the next second */
	vt1 = 20000000 + curFileTime.QuadPart;
	driftFreq = (estFreq * 20000000 / (vt1 - vt0));
	/*
	 * Avoid too large drifts (only half of the current difference),
	 * that allows also be more accurate (aspire to the smallest tdiff),
	 * so then we can prolong calibration interval by tdiff < 100000
	 */
	driftFreq = timeInfo.curCounterFreq.QuadPart +
		(driftFreq - timeInfo.curCounterFreq.QuadPart) / 2;

	/*
	 * Average between estimated, 2 current and 5 drifted frequencies,
	 * (do the soft drifting as possible)
	 */
	estFreq = (estFreq + 2 * timeInfo.curCounterFreq.QuadPart + 5 * driftFreq) / 8;
    }

    /* Avoid too large discrepancy from nominal frequency */
    if (estFreq > 1003*timeInfo.nominalFreq.QuadPart/1000) {
	estFreq = 1003*timeInfo.nominalFreq.QuadPart/1000;
	vt0 = curFileTime.QuadPart;
    } else if (estFreq < 997*timeInfo.nominalFreq.QuadPart/1000) {
	estFreq = 997*timeInfo.nominalFreq.QuadPart/1000;
	vt0 = curFileTime.QuadPart;
    } else if (vt0 != curFileTime.QuadPart) {
	/*
	 * Be sure the clock ticks never backwards (avoid it by negative drifting)
	 * just compare native time (in 100-ns) before and hereafter using
	 * new calibrated values) and do a small adjustment (short time freeze)
	 */
	LARGE_INTEGER newPerfCounter;
	Tcl_WideInt nt0, nt1;

	QueryPerformanceCounter(&newPerfCounter);
	nt0 = NativeCalc100NsTicks(timeInfo.fileTimeLastCall.QuadPart,