Tcl Source Code

2012-04-02  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#396.

	* generic/tclBasic.c (builtInCmds, TclNRYieldToObjCmd): Convert the
	formerly-unsupported yieldm and yieldTo commands into [yieldto].

    unsigned long TclpGetSeconds(void)
}

# deprecated
declare 77 {
    void TclpGetTime(Tcl_Time *time)
}

declare 78 {
    int TclpGetTimeZone(unsigned long time)
}

# Replaced by Tcl_FSListVolumes in 8.4:
#declare 79 {
#    int TclpListVolumes(Tcl_Interp *interp)
#}
# Replaced by Tcl_FSOpenFileChannel in 8.4:
#declare 80 {
#    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName,

#    void TclpAsyncMark(Tcl_AsyncHandler async)
#}

# Added in 8.1:
declare 22 win {
    TclFile TclpCreateTempFile(const char *contents)
}

declare 23 win {
    char *TclpGetTZName(int isdst)
}

declare 24 win {
    char *TclWinNoBackslash(char *path)
}
# replaced by generic TclGetPlatform
#declare 25 win {
#    TclPlatformType *TclWinGetPlatform(void)
#}

}
declare 20 unix {
    void TclWinAddProcess(void *hProcess, unsigned int id)
}
declare 22 unix {
    TclFile TclpCreateTempFile(const char *contents)
}

declare 23 unix {
    char *TclpGetTZName(int isdst)
}

declare 24 unix {
    char *TclWinNoBackslash(char *path)
}
declare 26 unix {
    void TclWinSetInterfaces(int wide)
}
declare 27 unix {

EXTERN void		TclpFree(char *ptr);
/* 75 */
EXTERN unsigned long	TclpGetClicks(void);
/* 76 */
EXTERN unsigned long	TclpGetSeconds(void);
/* 77 */
EXTERN void		TclpGetTime(Tcl_Time *time);
/* 78 */
EXTERN int		TclpGetTimeZone(unsigned long time);
/* Slot 79 is reserved */
/* Slot 80 is reserved */
/* 81 */
EXTERN char *		TclpRealloc(char *ptr, unsigned int size);
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */

    void (*reserved71)(void);
    void (*reserved72)(void);
    void (*reserved73)(void);
    void (*tclpFree) (char *ptr); /* 74 */
    unsigned long (*tclpGetClicks) (void); /* 75 */
    unsigned long (*tclpGetSeconds) (void); /* 76 */
    void (*tclpGetTime) (Tcl_Time *time); /* 77 */
    int (*tclpGetTimeZone) (unsigned long time); /* 78 */
    void (*reserved79)(void);
    void (*reserved80)(void);
    char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
    void (*reserved82)(void);
    void (*reserved83)(void);
    void (*reserved84)(void);
    void (*reserved85)(void);

	(tclIntStubsPtr->tclpFree) /* 74 */
#define TclpGetClicks \
	(tclIntStubsPtr->tclpGetClicks) /* 75 */
#define TclpGetSeconds \
	(tclIntStubsPtr->tclpGetSeconds) /* 76 */
#define TclpGetTime \
	(tclIntStubsPtr->tclpGetTime) /* 77 */
#define TclpGetTimeZone \
	(tclIntStubsPtr->tclpGetTimeZone) /* 78 */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
#define TclpRealloc \
	(tclIntStubsPtr->tclpRealloc) /* 81 */
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */

EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* 20 */
EXTERN void		TclWinAddProcess(void *hProcess, unsigned int id);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 23 */
EXTERN char *		TclpGetTZName(int isdst);
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
EXTERN void		TclWinSetInterfaces(int wide);
/* 27 */
EXTERN void		TclWinFlushDirtyChannels(void);

/* 19 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void		TclWinAddProcess(HANDLE hProcess, DWORD id);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 23 */
EXTERN char *		TclpGetTZName(int isdst);
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
EXTERN void		TclWinSetInterfaces(int wide);
/* 27 */
EXTERN void		TclWinFlushDirtyChannels(void);

EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* 20 */
EXTERN void		TclWinAddProcess(void *hProcess, unsigned int id);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 23 */
EXTERN char *		TclpGetTZName(int isdst);
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
EXTERN void		TclWinSetInterfaces(int wide);
/* 27 */
EXTERN void		TclWinFlushDirtyChannels(void);

    void (*reserved16)(void);
    void (*reserved17)(void);
    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
    void (*tclWinAddProcess) (void *hProcess, unsigned int id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    char * (*tclpGetTZName) (int isdst); /* 23 */
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*tclWinSetInterfaces) (int wide); /* 26 */
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*tclWinResetInterfaces) (void); /* 28 */
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 30 */

    void (*reserved16)(void);
    void (*reserved17)(void);
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
    void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    char * (*tclpGetTZName) (int isdst); /* 23 */
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*tclWinSetInterfaces) (int wide); /* 26 */
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*tclWinResetInterfaces) (void); /* 28 */
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
#endif /* WIN */

    int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
    int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
    void (*tclWinAddProcess) (void *hProcess, unsigned int id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    char * (*tclpGetTZName) (int isdst); /* 23 */
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*tclWinSetInterfaces) (int wide); /* 26 */
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*tclWinResetInterfaces) (void); /* 28 */
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 30 */

#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
#define TclpGetTZName \
	(tclIntPlatStubsPtr->tclpGetTZName) /* 23 */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
#define TclWinSetInterfaces \
	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */

#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
#define TclpGetTZName \
	(tclIntPlatStubsPtr->tclpGetTZName) /* 23 */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
#define TclWinSetInterfaces \
	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */

#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
#define TclpGetTZName \
	(tclIntPlatStubsPtr->tclpGetTZName) /* 23 */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
#define TclWinSetInterfaces \
	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */

#define TclWinGetPlatformId winGetPlatformId
#define Tcl_WinUtfToTChar winUtfToTChar
#define Tcl_WinTCharToUtf winTCharToUtf
#define TclWinGetTclInstance winGetTclInstance
#define TclWinNToHS winNToHS
#define TclWinSetSockOpt winSetSockOpt
#define TclpGetTZName pGetTZName
#define TclWinNoBackslash winNoBackslash
#define TclWinSetInterfaces (void (*) (int)) doNothing
#define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
#define TclWinFlushDirtyChannels doNothing
#define TclWinResetInterfaces doNothing

static Tcl_Encoding winTCharEncoding;

static int
TclWinSetSockOpt(void *s, int level, int optname,
	    const char *optval, int optlen)
{
    return setsockopt((int) s, level, optname, optval, optlen);
}

static char *
TclpGetTZName(int isdst)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    const char *zone = getenv("TZ");
    Tcl_ExternalToUtf(NULL, NULL, zone, strlen(zone), 0, NULL,
	    tsdPtr->tzName, sizeof(tsdPtr->tzName), NULL, NULL, NULL);
    return tsdPtr->tzName;
}

static char *
TclWinNoBackslash(char *path)
{
    char *p;

    for (p = path; *p != '\0'; p++) {
	if (*p == '\\') {

#   undef TclWinConvertWSAError
#   define TclWinConvertWSAError (void (*) _ANSI_ARGS_((unsigned int))) TclpCloseFile
#   define TclWinGetPlatformId (int (*)()) TclpCreateTempFile
#   define TclWinGetTclInstance (void *(*)()) TclpCreateProcess
#   define TclWinNToHS (unsigned short (*) _ANSI_ARGS_((unsigned short ns))) TclpMakeFile
#   define TclWinSetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, const char *, int))) TclpOpenFile
#   define TclWinAddProcess 0
#   define TclpGetTZName 0
#   define TclWinNoBackslash 0
#   define TclWinSetInterfaces 0
#   define TclWinFlushDirtyChannels 0
#   define TclWinResetInterfaces 0
#   define TclMacOSXGetFileAttribute 0 /* Only implemented in Tcl >= 8.5 */
#   define TclMacOSXMatchType 0 /* Only implemented in Tcl >= 8.5 */
#   define TclMacOSXNotifierAddRunLoopMode 0 /* Only implemented in Tcl >= 8.5 */

    0, /* 71 */
    0, /* 72 */
    0, /* 73 */
    TclpFree, /* 74 */
    TclpGetClicks, /* 75 */
    TclpGetSeconds, /* 76 */
    TclpGetTime, /* 77 */
    TclpGetTimeZone, /* 78 */
    0, /* 79 */
    0, /* 80 */
    TclpRealloc, /* 81 */
    0, /* 82 */
    0, /* 83 */
    0, /* 84 */
    0, /* 85 */

    0, /* 16 */
    0, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpCreateTempFile, /* 22 */
    TclpGetTZName, /* 23 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    TclWinSetInterfaces, /* 26 */
    TclWinFlushDirtyChannels, /* 27 */
    TclWinResetInterfaces, /* 28 */
    TclWinCPUID, /* 29 */
    TclGetAndDetachPids, /* 30 */

    0, /* 16 */
    0, /* 17 */
    TclpMakeFile, /* 18 */
    TclpOpenFile, /* 19 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpCreateTempFile, /* 22 */
    TclpGetTZName, /* 23 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    TclWinSetInterfaces, /* 26 */
    TclWinFlushDirtyChannels, /* 27 */
    TclWinResetInterfaces, /* 28 */
    TclWinCPUID, /* 29 */
#endif /* WIN */

    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpCreateTempFile, /* 22 */
    TclpGetTZName, /* 23 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    TclWinSetInterfaces, /* 26 */
    TclWinFlushDirtyChannels, /* 27 */
    TclWinResetInterfaces, /* 28 */
    TclWinCPUID, /* 29 */
    TclGetAndDetachPids, /* 30 */

#error Wide high-resolution clicks not implemented on this platform
#endif
    }

    return nsec;
}
#endif /* TCL_WIDE_CLICKS */

/*
 *----------------------------------------------------------------------
 *
 * TclpGetTimeZone --
 *
 *	Determines the current timezone. The method varies wildly between
 *	different platform implementations, so its hidden in this function.
 *
 * Results:
 *	The return value is the local time zone, measured in minutes away from
 *	GMT (-ve for east, +ve for west).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclpGetTimeZone(
    unsigned long currentTime)
{
    int timeZone;

    /*
     * We prefer first to use the time zone in "struct tm" if the structure
     * contains such a member. Following that, we try to locate the external
     * 'timezone' variable and use its value. If both of those methods fail,
     * we attempt to convert a known time to local time and use the difference
     * from UTC as the local time zone. In all cases, we need to undo any
     * Daylight Saving Time adjustment.
     */

#if defined(HAVE_TM_TZADJ)
#define TCL_GOT_TIMEZONE
    /*
     * Struct tm contains tm_tzadj - that value may be used.
     */

    time_t curTime = (time_t) currentTime;
    struct tm *timeDataPtr = TclpLocaltime(&curTime);

    timeZone = timeDataPtr->tm_tzadj / 60;
    if (timeDataPtr->tm_isdst) {
	timeZone += 60;
    }
#endif

#if defined(HAVE_TM_GMTOFF) && !defined (TCL_GOT_TIMEZONE)
#define TCL_GOT_TIMEZONE
    /*
     * Struct tm contains tm_gmtoff - that value may be used.
     */

    time_t curTime = (time_t) currentTime;
    struct tm *timeDataPtr = TclpLocaltime(&curTime);

    timeZone = -(timeDataPtr->tm_gmtoff / 60);
    if (timeDataPtr->tm_isdst) {
	timeZone += 60;
    }
#endif

#if defined(HAVE_TIMEZONE_VAR) && !defined(TCL_GOT_TIMEZONE) && !defined(USE_DELTA_FOR_TZ)
#define TCL_GOT_TIMEZONE
    /*
     * The 'timezone' external var is present and may be used.
     */

    SetTZIfNecessary();

    /*
     * Note: this is not a typo in "timezone" below! See tzset documentation
     * for details.
     */

    timeZone = timezone / 60;
#endif

#if !defined(TCL_GOT_TIMEZONE)
#define TCL_GOT_TIMEZONE
    /*
     * Fallback - determine time zone with a known reference time.
     */

    time_t tt;
    struct tm *stm;

    tt = 849268800L;		/* 1996-11-29 12:00:00  GMT */
    stm = TclpLocaltime(&tt);	/* eg 1996-11-29  6:00:00  CST6CDT */

    /*
     * The calculation below assumes a max of +12 or -12 hours from GMT.
     */

    timeZone = (12 - stm->tm_hour)*60 + (0 - stm->tm_min);
    if (stm->tm_isdst) {
	timeZone += 60;
    }

    /*
     * Now have offset for our known reference time, eg +360 for CST6CDT.
     */
#endif

#ifndef TCL_GOT_TIMEZONE
    /*
     * Cause fatal compile error, we don't know how to get timezone.
     */

#error autoconf did not figure out how to determine the timezone.
#endif

    return timeZone;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetTime --
 *
 *	Gets the current system time in seconds and microseconds since the

    return retval;

}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetTimeZone --
 *
 *	Determines the current timezone. The method varies wildly between
 *	different Platform implementations, so its hidden in this function.
 *
 * Results:
 *	Minutes west of GMT.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclpGetTimeZone(
    unsigned long currentTime)
{
    int timeZone;

    tzset();
    timeZone = timezone / 60;

    return timeZone;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetTime --
 *
 *	Gets the current system time in seconds and microseconds since the
 *	beginning of the epoch: 00:00 UCT, January 1, 1970.
 *
 * Results:
 *	Returns the current time in timePtr.

     * paused state so we need to timeout and continue.
     */

    WaitForSingleObject(timeInfo.calibrationThread, 100);
    CloseHandle(timeInfo.exitEvent);
    CloseHandle(timeInfo.calibrationThread);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetTZName --
 *
 *	Gets the current timezone string.
 *
 * Results:
 *	Returns a pointer to a static string, or NULL on failure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpGetTZName(
    int dst)
{
    int len;
    char *zone, *p;
    TIME_ZONE_INFORMATION tz;
    Tcl_Encoding encoding;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    char *name = tsdPtr->tzName;

    /*
     * tzset() under Borland doesn't seem to set up tzname[] at all.
     * tzset() under MSVC has the following weird observed behavior:
     *	 First time we call "clock format [clock seconds] -format %Z -gmt 1"
     *	 we get "GMT", but on all subsequent calls we get the current time
     *	 ezone string, even though env(TZ) is GMT and the variable _timezone
     *	 is 0.
     */

    name[0] = '\0';

    zone = getenv("TZ");
    if (zone != NULL) {
	/*
	 * TZ is of form "NST-4:30NDT", where "NST" would be the name of the
	 * standard time zone for this area, "-4:30" is the offset from GMT in
	 * hours, and "NDT is the name of the daylight savings time zone in
	 * this area. The offset and DST strings are optional.
	 */

	len = strlen(zone);
	if (len > 3) {
	    len = 3;
	}
	if (dst != 0) {
	    /*
	     * Skip the offset string and get the DST string.
	     */

	    p = zone + len;
	    p += strspn(p, "+-:0123456789");
	    if (*p != '\0') {
		zone = p;
		len = strlen(zone);
		if (len > 3) {
		    len = 3;
		}
	    }
	}
	Tcl_ExternalToUtf(NULL, NULL, zone, len, 0, NULL, name,
		sizeof(tsdPtr->tzName), NULL, NULL, NULL);
    }
    if (name[0] == '\0') {
	if (GetTimeZoneInformation(&tz) == TIME_ZONE_ID_UNKNOWN) {
	    /*
	     * MSDN: On NT this is returned if DST is not used in the current
	     * TZ
	     */

	    dst = 0;
	}
	encoding = Tcl_GetEncoding(NULL, "unicode");
	Tcl_ExternalToUtf(NULL, encoding,
		(char *) ((dst) ? tz.DaylightName : tz.StandardName), -1,
		0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL);
	Tcl_FreeEncoding(encoding);
    }
    return name;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetDate --
 *
 *	This function converts between seconds and struct tm. If useGMT is