URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [generic/] [tclClock.c] - Blame information for rev 1774

Go to most recent revision | Details | Compare with Previous | View Log


/*
 * tclClock.c --
 *
 *      Contains the time and date related commands.  This code
 *      is derived from the time and date facilities of TclX,
 *      by Mark Diekhans and Karl Lehenbauer.
 *
 * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995 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: tclClock.c,v 1.1.1.1 2002-01-16 10:25:25 markom Exp $
 */
 
#include "tcl.h"
#include "tclInt.h"
#include "tclPort.h"
 
/*
 * Function prototypes for local procedures in this file:
 */
 
static int              FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
                            unsigned long clockVal, int useGMT,
                            char *format));
 
/*
 *-------------------------------------------------------------------------
 *
 * Tcl_ClockObjCmd --
 *
 *      This procedure is invoked to process the "clock" Tcl command.
 *      See the user documentation for details on what it does.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      See the user documentation.
 *
 *-------------------------------------------------------------------------
 */
 
int
Tcl_ClockObjCmd (client, interp, objc, objv)
    ClientData client;                  /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int objc;                           /* Number of arguments. */
    Tcl_Obj *CONST objv[];              /* Argument values. */
{
    Tcl_Obj *resultPtr;
    int index;
    Tcl_Obj *CONST *objPtr;
    int useGMT = 0;
    char *format = "%a %b %d %X %Z %Y";
    int dummy;
    unsigned long baseClock, clockVal;
    long zone;
    Tcl_Obj *baseObjPtr = NULL;
    char *scanStr;
 
    static char *switches[] =
            {"clicks", "format", "scan", "seconds", (char *) NULL};
    static char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};
    static char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};
 
    resultPtr = Tcl_GetObjResult(interp);
    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
        return TCL_ERROR;
    }
 
    if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
            != TCL_OK) {
        return TCL_ERROR;
    }
    switch (index) {
        case 0:                  /* clicks */
            if (objc != 2) {
                Tcl_WrongNumArgs(interp, 2, objv, NULL);
                return TCL_ERROR;
            }
            Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());
            return TCL_OK;
        case 1:                 /* format */
            if ((objc < 3) || (objc > 7)) {
                wrongFmtArgs:
                Tcl_WrongNumArgs(interp, 2, objv,
                        "clockval ?-format string? ?-gmt boolean?");
                return TCL_ERROR;
            }
 
            if (Tcl_GetLongFromObj(interp, objv[2], (long*) &clockVal)
                    != TCL_OK) {
                return TCL_ERROR;
            }
 
            objPtr = objv+3;
            objc -= 3;
            while (objc > 1) {
                if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches,
                        "switch", 0, &index) != TCL_OK) {
                    return TCL_ERROR;
                }
                switch (index) {
                    case 0:              /* -format */
                        format = Tcl_GetStringFromObj(objPtr[1], &dummy);
                        break;
                    case 1:             /* -gmt */
                        if (Tcl_GetBooleanFromObj(interp, objPtr[1],
                                &useGMT) != TCL_OK) {
                            return TCL_ERROR;
                        }
                        break;
                }
                objPtr += 2;
                objc -= 2;
            }
            if (objc != 0) {
                goto wrongFmtArgs;
            }
            return FormatClock(interp, (unsigned long) clockVal, useGMT,
                    format);
        case 2:                 /* scan */
            if ((objc < 3) || (objc > 7)) {
                wrongScanArgs:
                Tcl_WrongNumArgs(interp, 2, objv,
                        "dateString ?-base clockValue? ?-gmt boolean?");
                return TCL_ERROR;
            }
 
            objPtr = objv+3;
            objc -= 3;
            while (objc > 1) {
                if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches,
                        "switch", 0, &index) != TCL_OK) {
                    return TCL_ERROR;
                }
                switch (index) {
                    case 0:              /* -base */
                        baseObjPtr = objPtr[1];
                        break;
                    case 1:             /* -gmt */
                        if (Tcl_GetBooleanFromObj(interp, objPtr[1],
                                &useGMT) != TCL_OK) {
                            return TCL_ERROR;
                        }
                        break;
                }
                objPtr += 2;
                objc -= 2;
            }
            if (objc != 0) {
                goto wrongScanArgs;
            }
 
            if (baseObjPtr != NULL) {
                if (Tcl_GetLongFromObj(interp, baseObjPtr,
                        (long*) &baseClock) != TCL_OK) {
                    return TCL_ERROR;
                }
            } else {
                baseClock = TclpGetSeconds();
            }
 
            if (useGMT) {
                zone = -50000; /* Force GMT */
            } else {
                zone = TclpGetTimeZone((unsigned long) baseClock);
            }
 
            scanStr = Tcl_GetStringFromObj(objv[2], &dummy);
            if (TclGetDate(scanStr, (unsigned long) baseClock, zone,
                    (unsigned long *) &clockVal) < 0) {
                Tcl_AppendStringsToObj(resultPtr,
                        "unable to convert date-time string \"",
                        scanStr, "\"", (char *) NULL);
                return TCL_ERROR;
            }
 
            Tcl_SetLongObj(resultPtr, (long) clockVal);
            return TCL_OK;
        case 3:                 /* seconds */
            if (objc != 2) {
                Tcl_WrongNumArgs(interp, 2, objv, NULL);
                return TCL_ERROR;
            }
            Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds());
            return TCL_OK;
        default:
            return TCL_ERROR;   /* Should never be reached. */
    }
}
 
/*
 *-----------------------------------------------------------------------------
 *
 * FormatClock --
 *
 *      Formats a time value based on seconds into a human readable
 *      string.
 *
 * Results:
 *      Standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *-----------------------------------------------------------------------------
 */
 
static int
FormatClock(interp, clockVal, useGMT, format)
    Tcl_Interp *interp;                 /* Current interpreter. */
    unsigned long clockVal;             /* Time in seconds. */
    int useGMT;                         /* Boolean */
    char *format;                       /* Format string */
{
    struct tm *timeDataPtr;
    Tcl_DString buffer;
    int bufSize;
    char *p;
#ifdef TCL_USE_TIMEZONE_VAR
    int savedTimeZone;
    char *savedTZEnv;
#endif
    Tcl_Obj *resultPtr;
 
    resultPtr = Tcl_GetObjResult(interp);
#ifdef HAVE_TZSET
    /*
     * Some systems forgot to call tzset in localtime, make sure its done.
     */
    static int  calledTzset = 0;
 
    if (!calledTzset) {
        tzset();
        calledTzset = 1;
    }
#endif
 
#ifdef TCL_USE_TIMEZONE_VAR
    /*
     * This is a horrible kludge for systems not having the timezone in
     * struct tm.  No matter what was specified, they use the global time
     * zone.  (Thanks Solaris).
     */
    if (useGMT) {
        char *varValue;
 
        varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
        if (varValue != NULL) {
            savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
        } else {
            savedTZEnv = NULL;
        }
        Tcl_SetVar2(interp, "env", "TZ", "GMT", TCL_GLOBAL_ONLY);
        savedTimeZone = timezone;
        timezone = 0;
        tzset();
    }
#endif
 
    timeDataPtr = TclpGetDate((time_t *) &clockVal, useGMT);
 
    /*
     * Make a guess at the upper limit on the substituted string size
     * based on the number of percents in the string.
     */
 
    for (bufSize = 1, p = format; *p != '\0'; p++) {
        if (*p == '%') {
            bufSize += 40;
        } else {
            bufSize++;
        }
    }
    Tcl_DStringInit(&buffer);
    Tcl_DStringSetLength(&buffer, bufSize);
 
    if ((TclStrftime(buffer.string, (unsigned int) bufSize, format,
            timeDataPtr) == 0) && (*format != '\0')) {
        Tcl_AppendStringsToObj(resultPtr, "bad format string \"",
                format, "\"", (char *) NULL);
        return TCL_ERROR;
    }
 
#ifdef TCL_USE_TIMEZONE_VAR
    if (useGMT) {
        if (savedTZEnv != NULL) {
            Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
            ckfree(savedTZEnv);
        } else {
            Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
        }
        timezone = savedTimeZone;
        tzset();
    }
#endif
 
    Tcl_SetStringObj(resultPtr, buffer.string, -1);
    Tcl_DStringFree(&buffer);
    return TCL_OK;
}
 

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [generic/] [tclClock.c] - Blame information for rev 1774

Line No.	Rev	Author	Line
1	578	markom	`/*`
2			`* tclClock.c --`
3			`*`
4			`* Contains the time and date related commands. This code`
5			`* is derived from the time and date facilities of TclX,`
6			`* by Mark Diekhans and Karl Lehenbauer.`
7			`*`
8			`* Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.`
9			`* Copyright (c) 1995 Sun Microsystems, Inc.`
10			`*`
11			`* See the file "license.terms" for information on usage and redistribution`
12			`* of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
13			`*`
14			`* RCS: @(#) $Id: tclClock.c,v 1.1.1.1 2002-01-16 10:25:25 markom Exp $`
15			`*/`
16
17			`#include "tcl.h"`
18			`#include "tclInt.h"`
19			`#include "tclPort.h"`
20
21			`/*`
22			`* Function prototypes for local procedures in this file:`
23			`*/`
24
25			`static int FormatClock _ANSI_ARGS_((Tcl_Interp *interp,`
26			`unsigned long clockVal, int useGMT,`
27			`char *format));`
28
29			`/*`
30			`*-------------------------------------------------------------------------`
31			`*`
32			`* Tcl_ClockObjCmd --`
33			`*`
34			`* This procedure is invoked to process the "clock" Tcl command.`
35			`* See the user documentation for details on what it does.`
36			`*`
37			`* Results:`
38			`* A standard Tcl result.`
39			`*`
40			`* Side effects:`
41			`* See the user documentation.`
42			`*`
43			`*-------------------------------------------------------------------------`
44			`*/`
45
46			`int`
47			`Tcl_ClockObjCmd (client, interp, objc, objv)`
48			`ClientData client; /* Not used. */`
49			`Tcl_Interp interp; / Current interpreter. */`
50			`int objc; /* Number of arguments. */`
51			`Tcl_Obj CONST objv[]; / Argument values. */`
52			`{`
53			`Tcl_Obj *resultPtr;`
54			`int index;`
55			`Tcl_Obj CONST objPtr;`
56			`int useGMT = 0;`
57			`char *format = "%a %b %d %X %Z %Y";`
58			`int dummy;`
59			`unsigned long baseClock, clockVal;`
60			`long zone;`
61			`Tcl_Obj *baseObjPtr = NULL;`
62			`char *scanStr;`
63
64			`static char *switches[] =`
65			`{"clicks", "format", "scan", "seconds", (char *) NULL};`
66			`static char formatSwitches[] = {"-format", "-gmt", (char ) NULL};`
67			`static char scanSwitches[] = {"-base", "-gmt", (char ) NULL};`
68
69			`resultPtr = Tcl_GetObjResult(interp);`
70			`if (objc < 2) {`
71			`Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");`
72			`return TCL_ERROR;`
73			`}`
74
75			`if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)`
76			`!= TCL_OK) {`
77			`return TCL_ERROR;`
78			`}`
79			`switch (index) {`
80			`case 0: /* clicks */`
81			`if (objc != 2) {`
82			`Tcl_WrongNumArgs(interp, 2, objv, NULL);`
83			`return TCL_ERROR;`
84			`}`
85			`Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());`
86			`return TCL_OK;`
87			`case 1: /* format */`
88			`if ((objc < 3) \|\| (objc > 7)) {`
89			`wrongFmtArgs:`
90			`Tcl_WrongNumArgs(interp, 2, objv,`
91			`"clockval ?-format string? ?-gmt boolean?");`
92			`return TCL_ERROR;`
93			`}`
94
95			`if (Tcl_GetLongFromObj(interp, objv[2], (long*) &clockVal)`
96			`!= TCL_OK) {`
97			`return TCL_ERROR;`
98			`}`
99
100			`objPtr = objv+3;`
101			`objc -= 3;`
102			`while (objc > 1) {`
103			`if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches,`
104			`"switch", 0, &index) != TCL_OK) {`
105			`return TCL_ERROR;`
106			`}`
107			`switch (index) {`
108			`case 0: /* -format */`
109			`format = Tcl_GetStringFromObj(objPtr[1], &dummy);`
110			`break;`
111			`case 1: /* -gmt */`
112			`if (Tcl_GetBooleanFromObj(interp, objPtr[1],`
113			`&useGMT) != TCL_OK) {`
114			`return TCL_ERROR;`
115			`}`
116			`break;`
117			`}`
118			`objPtr += 2;`
119			`objc -= 2;`
120			`}`
121			`if (objc != 0) {`
122			`goto wrongFmtArgs;`
123			`}`
124			`return FormatClock(interp, (unsigned long) clockVal, useGMT,`
125			`format);`
126			`case 2: /* scan */`
127			`if ((objc < 3) \|\| (objc > 7)) {`
128			`wrongScanArgs:`
129			`Tcl_WrongNumArgs(interp, 2, objv,`
130			`"dateString ?-base clockValue? ?-gmt boolean?");`
131			`return TCL_ERROR;`
132			`}`
133
134			`objPtr = objv+3;`
135			`objc -= 3;`
136			`while (objc > 1) {`
137			`if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches,`
138			`"switch", 0, &index) != TCL_OK) {`
139			`return TCL_ERROR;`
140			`}`
141			`switch (index) {`
142			`case 0: /* -base */`
143			`baseObjPtr = objPtr[1];`
144			`break;`
145			`case 1: /* -gmt */`
146			`if (Tcl_GetBooleanFromObj(interp, objPtr[1],`
147			`&useGMT) != TCL_OK) {`
148			`return TCL_ERROR;`
149			`}`
150			`break;`
151			`}`
152			`objPtr += 2;`
153			`objc -= 2;`
154			`}`
155			`if (objc != 0) {`
156			`goto wrongScanArgs;`
157			`}`
158
159			`if (baseObjPtr != NULL) {`
160			`if (Tcl_GetLongFromObj(interp, baseObjPtr,`
161			`(long*) &baseClock) != TCL_OK) {`
162			`return TCL_ERROR;`
163			`}`
164			`} else {`
165			`baseClock = TclpGetSeconds();`
166			`}`
167
168			`if (useGMT) {`
169			`zone = -50000; /* Force GMT */`
170			`} else {`
171			`zone = TclpGetTimeZone((unsigned long) baseClock);`
172			`}`
173
174			`scanStr = Tcl_GetStringFromObj(objv[2], &dummy);`
175			`if (TclGetDate(scanStr, (unsigned long) baseClock, zone,`
176			`(unsigned long *) &clockVal) < 0) {`
177			`Tcl_AppendStringsToObj(resultPtr,`
178			`"unable to convert date-time string \"",`
179			`scanStr, "\"", (char *) NULL);`
180			`return TCL_ERROR;`
181			`}`
182
183			`Tcl_SetLongObj(resultPtr, (long) clockVal);`
184			`return TCL_OK;`
185			`case 3: /* seconds */`
186			`if (objc != 2) {`
187			`Tcl_WrongNumArgs(interp, 2, objv, NULL);`
188			`return TCL_ERROR;`
189			`}`
190			`Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds());`
191			`return TCL_OK;`
192			`default:`
193			`return TCL_ERROR; /* Should never be reached. */`
194			`}`
195			`}`
196
197			`/*`
198			`*-----------------------------------------------------------------------------`
199			`*`
200			`* FormatClock --`
201			`*`
202			`* Formats a time value based on seconds into a human readable`
203			`* string.`
204			`*`
205			`* Results:`
206			`* Standard Tcl result.`
207			`*`
208			`* Side effects:`
209			`* None.`
210			`*`
211			`*-----------------------------------------------------------------------------`
212			`*/`
213
214			`static int`
215			`FormatClock(interp, clockVal, useGMT, format)`
216			`Tcl_Interp interp; / Current interpreter. */`
217			`unsigned long clockVal; /* Time in seconds. */`
218			`int useGMT; /* Boolean */`
219			`char format; / Format string */`
220			`{`
221			`struct tm *timeDataPtr;`
222			`Tcl_DString buffer;`
223			`int bufSize;`
224			`char *p;`
225			`#ifdef TCL_USE_TIMEZONE_VAR`
226			`int savedTimeZone;`
227			`char *savedTZEnv;`
228			`#endif`
229			`Tcl_Obj *resultPtr;`
230
231			`resultPtr = Tcl_GetObjResult(interp);`
232			`#ifdef HAVE_TZSET`
233			`/*`
234			`* Some systems forgot to call tzset in localtime, make sure its done.`
235			`*/`
236			`static int calledTzset = 0;`
237
238			`if (!calledTzset) {`
239			`tzset();`
240			`calledTzset = 1;`
241			`}`
242			`#endif`
243
244			`#ifdef TCL_USE_TIMEZONE_VAR`
245			`/*`
246			`* This is a horrible kludge for systems not having the timezone in`
247			`* struct tm. No matter what was specified, they use the global time`
248			`* zone. (Thanks Solaris).`
249			`*/`
250			`if (useGMT) {`
251			`char *varValue;`
252
253			`varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);`
254			`if (varValue != NULL) {`
255			`savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);`
256			`} else {`
257			`savedTZEnv = NULL;`
258			`}`
259			`Tcl_SetVar2(interp, "env", "TZ", "GMT", TCL_GLOBAL_ONLY);`
260			`savedTimeZone = timezone;`
261			`timezone = 0;`
262			`tzset();`
263			`}`
264			`#endif`
265
266			`timeDataPtr = TclpGetDate((time_t *) &clockVal, useGMT);`
267
268			`/*`
269			`* Make a guess at the upper limit on the substituted string size`
270			`* based on the number of percents in the string.`
271			`*/`
272
273			`for (bufSize = 1, p = format; *p != '\0'; p++) {`
274			`if (*p == '%') {`
275			`bufSize += 40;`
276			`} else {`
277			`bufSize++;`
278			`}`
279			`}`
280			`Tcl_DStringInit(&buffer);`
281			`Tcl_DStringSetLength(&buffer, bufSize);`
282
283			`if ((TclStrftime(buffer.string, (unsigned int) bufSize, format,`
284			`timeDataPtr) == 0) && (*format != '\0')) {`
285			`Tcl_AppendStringsToObj(resultPtr, "bad format string \"",`
286			`format, "\"", (char *) NULL);`
287			`return TCL_ERROR;`
288			`}`
289
290			`#ifdef TCL_USE_TIMEZONE_VAR`
291			`if (useGMT) {`
292			`if (savedTZEnv != NULL) {`
293			`Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);`
294			`ckfree(savedTZEnv);`
295			`} else {`
296			`Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);`
297			`}`
298			`timezone = savedTimeZone;`
299			`tzset();`
300			`}`
301			`#endif`
302
303			`Tcl_SetStringObj(resultPtr, buffer.string, -1);`
304			`Tcl_DStringFree(&buffer);`
305			`return TCL_OK;`
306			`}`
307