Tcl Source Code

'\"
'\" Copyright (c) 2005 Sergey Brester aka sebres.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH timerate n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
timerate \- Time-related execution resp. performance measurement of a script
.SH SYNOPSIS
\fBtimerate \fIscript\fR \fI?time?\fR
.sp
\fBtimerate \fI?-direct?\fR \fI?-overhead double?\fR \fIscript\fR \fI?time?\fR
.sp
\fBtimerate \fI?-calibrate?\fR \fI?-direct?\fR \fIscript\fR \fI?time?\fR
.BE
.SH DESCRIPTION
.PP
The first and second form will evaluate \fIscript\fR until the interval
\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second)
if \fItime\fR is not specified. 
.sp
It will then return a canonical tcl-list of the form
.PP
.CS
\f0.095977 µs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR
.CE
.PP
which indicates:
.IP \(bu
the average amount of time required per iteration, in microseconds (lindex $result 0)
.IP \(bu
the count how many times it was executed (lindex $result 2)
.IP \(bu
the estimated rate per second (lindex $result 4)
.IP \(bu
the estimated real execution time without measurement overhead (lindex $result 6)
.PP
Time is measured in elapsed time using heighest timer resolution as possible, not CPU time.
This command may be used to provide information as to how well the script or a tcl-command 
is performing and can help determine bottlenecks and fine-tune application performance.
.PP
\fI-calibrate\fR
.
To measure very fast scripts as exact as posible the calibration process
may be required.

This parameter used to calibrate \fBtimerate\fR calculating the estimated overhead 
of given \fIscript\fR as default overhead for further execution of \fBtimerate\fR.
It can take up to 10 seconds if parameter \fItime\fR is not specified.
.PP
\fI-overhead double\fR
.
This parameter used to supply the measurement overhead of single iteration 
(in microseconds) that should be ignored during whole evaluation process.
.PP
\fI-direct\fR
.
Causes direct execution per iteration (not compiled variant of evaluation used).
.PP
In opposition to \fBtime\fR the execution limited here by fixed time instead of 
repetition count.
Additionally the compiled variant of the script will be used during whole evaluation 
(as if it were part of a compiled \fBproc\fR), if parameter \fI-direct\fR is not specified.
Therefore it provides more precise results and prevents very long execution time 
by slow scripts resp. scripts with unknown speed.

.SH EXAMPLE
Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including
operations on variable \fIi\fR) to count to a ten:
.PP
.CS
# calibrate:
timerate -calibrate {}
# measure:
timerate { for {set i 0} {$i<10} {incr i} {} } 5000
.CE
.PP
Estimate how fast it takes for a simple Tcl \fBfor\fR loop only (ignoring the 
overhead for operations on variable \fIi\fR) to count to a ten:
.PP
.CS
# calibrate for overhead of variable operations:
set i 0; timerate -calibrate {expr {$i<10}; incr i} 1000
# measure:
timerate { for {set i 0} {$i<10} {incr i} {} } 5000
.CE
.PP
Estimate the rate of calculating the hour using \fBclock format\fR only, ignoring 
overhead of the rest, without measurement how fast it takes for a whole script:
.PP
.CS
# calibrate:
timerate -calibrate {}
# estimate overhead:
set tm 0
set ovh [lindex [timerate { incr tm [expr {24*60*60}] }] 0]
# measure using esimated overhead:
set tm 0
timerate -overhead $ovh {
    clock format $tm -format %H
    incr tm [expr {24*60*60}]; # overhead for this is ignored
} 5000
.CE
.SH "SEE ALSO"
time(n)
.SH KEYWORDS
script, timerate, time
.\" Local Variables:
.\" mode: nroff
.\" End:

    {"pwd",		Tcl_PwdObjCmd,		NULL,			0},
    {"read",		Tcl_ReadObjCmd,		NULL,			1},
    {"seek",		Tcl_SeekObjCmd,		NULL,			1},
    {"socket",		Tcl_SocketObjCmd,	NULL,			0},
    {"source",		Tcl_SourceObjCmd,	NULL,			0},
    {"tell",		Tcl_TellObjCmd,		NULL,			1},
    {"time",		Tcl_TimeObjCmd,		NULL,			1},
    {"timerate",	Tcl_TimeRateObjCmd,	NULL,			1},
    {"unload",		Tcl_UnloadObjCmd,	NULL,			0},
    {"update",		Tcl_UpdateObjCmd,	NULL,			1},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			1},
    {NULL,		NULL,			NULL,			0}
};

/*

#else
	Tcl_WideInt clicks = TclpGetWideClicks();
#endif
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) clicks));
	break;
    }
    case CLICKS_MICROS:

	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));

	break;
    }

    return TCL_OK;
}

/*----------------------------------------------------------------------

int
ClockMicrosecondsObjCmd(
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj* const* objv)	/* Parameter values */
{


    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));

    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * ClockParseformatargsObjCmd --

 * Copyright (c) 2003 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclRegexp.h"

static int		UniCharIsAscii(int character);
static int		UniCharIsHexDigit(int character);

/*
 *----------------------------------------------------------------------

    TclNewLiteralStringObj(objs[1], "microseconds");
    TclNewLiteralStringObj(objs[2], "per");
    TclNewLiteralStringObj(objs[3], "iteration");
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

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_WideInt count = 0;	/* Holds repetition count */
    Tcl_WideInt maxms = -0x7FFFFFFFFFFFFFFFL; 
				/* Maximal running time (in milliseconds) */
    Tcl_WideInt threshold = 1;	/* Current threshold for check time (faster
				 * repeat count without time check) */
    Tcl_WideInt maxIterTm = 1;	/* Max time of some iteration as max threshold
				 * additionally avoid divide to zero (never < 1) */
    register Tcl_WideInt start, middle, stop;
#ifndef TCL_WIDE_CLICKS
    Tcl_Time now;
#endif

    static const char *const options[] = {
	"-direct",	"-overhead",	"-calibrate",	"--",	NULL
    };
    enum options {
	TMRT_EV_DIRECT,	TMRT_OVERHEAD,	TMRT_CALIBRATE,	TMRT_LAST
    };

    ByteCode	 *codePtr = NULL;

    for (i = 1; i < objc - 1; i++) {
    	int index;
	if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    break;
	}
	if (index == TMRT_LAST) {
	    i++;
	    break;
	}
	switch (index) {
	case TMRT_EV_DIRECT:
	    direct = objv[i];
	    break;
	case TMRT_OVERHEAD:
	    if (++i >= objc - 1) {
		goto usage;
	    }
	    if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	case TMRT_CALIBRATE:
	    calibrate = objv[i];
	    break;
	}
    }

    if (i >= objc || i < objc-2) {
usage:
	Tcl_WrongNumArgs(interp, 1, objv, "?-direct? ?-calibrate? ?-overhead double? command ?time?");
	return TCL_ERROR;
    }
    objPtr = objv[i++];
    if (i < objc) {
	result = Tcl_GetWideIntFromObj(interp, objv[i], &maxms);
	if (result != TCL_OK) {
	    return result;
	}
    }

    /* if calibrate */
    if (calibrate) {

	/* if no time specified for the calibration */
	if (maxms == -0x7FFFFFFFFFFFFFFFL) {
	    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_IncrRefCount(clobjv[i]);
	    result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv);
	    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)0x7FFFFFFFFFFFFFFFL;

	    /* calibration cycle until it'll be preciser */
	    maxms = -1000;
	    do {
		lastMeasureOverhead = measureOverhead;
		TclNewLongObj(clobjv[i], (int)maxms);
		Tcl_IncrRefCount(clobjv[i]);
		result = Tcl_TimeRateObjCmd(dummy, interp, i+1, clobjv);
		Tcl_DecrRefCount(clobjv[i]);
		if (result != TCL_OK) {
		    return result;
		}
		maxCalTime += maxms;
		/* increase maxms for preciser calibration */
		maxms -= (-maxms / 4);
		/* as long as new value more as 0.05% better */
	    } while ( (measureOverhead >= lastMeasureOverhead
		    || measureOverhead / lastMeasureOverhead <= 0.9995)
		    && maxCalTime > 0
	    );

	    return result;
	}
	if (maxms == 0) {
	    /* reset last measurement overhead */
	    measureOverhead = 0;
	    Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
	    return TCL_OK;
	}

	/* if time is negative - make current overhead more precise */
	if (maxms > 0) {
	    /* set last measurement overhead to max */
	    measureOverhead = (double)0x7FFFFFFFFFFFFFFFL;
	} else {
	    maxms = -maxms;
	}

    }

    if (maxms == -0x7FFFFFFFFFFFFFFFL) {
    	maxms = 1000;
    }
    if (overhead == -1) {
	overhead = measureOverhead;
    }

    /* be sure that resetting of result will not smudge the further measurement */
    Tcl_ResetResult(interp);

    /* compile object */
    if (!direct) {
	if (TclInterpReady(interp) != TCL_OK) {
	    return TCL_ERROR;
	}
	codePtr = TclCompileObj(interp, objPtr, NULL, 0);
	TclPreserveByteCode(codePtr);
    }

    /* get start and stop time */
#ifdef TCL_WIDE_CLICKS
    start = middle = TclpGetWideClicks();
    /* time to stop execution (in wide clicks) */
    stop = start + (maxms * 1000 / TclpWideClickInMicrosec());
#else
    Tcl_GetTime(&now);
    start = now.sec; start *= 1000000; start += now.usec;
    middle = start;
    /* time to stop execution (in microsecs) */
    stop = start + maxms * 1000;
#endif

    /* start measurement */
    while (1) {
    	/* eval single iteration */
    	count++;

	if (!direct) {
	    /* precompiled */
	    result = TclExecuteByteCode(interp, codePtr);
	} else {
	    /* eval */
	    result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
	}
	if (result != TCL_OK) {
	    goto done;
	}
	
	/* 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
	Tcl_GetTime(&now);
	middle = now.sec; middle *= 1000000; middle += now.usec;
    #endif
	if (middle >= stop) {
	    break;
	}

	/* don't calculate threshold by few iterations, because sometimes
	 * first iteration(s) can be too fast (cached, delayed clean up, etc) */
	if (count < 10) {
	   threshold = 1; continue;
	}

	/* average iteration time in microsecs */
	threshold = (middle - start) / count;
	if (threshold > maxIterTm) {
	    maxIterTm = threshold;
	}
	/* as relation between remaining time and time since last check */
	threshold = ((stop - middle) / maxIterTm) / 4;
	if (threshold > 100000) {	    /* fix for too large threshold */
	    threshold = 100000;
	}
    }

    {
	Tcl_Obj *objarr[8], **objs = objarr;
	Tcl_WideInt val;
	const char *fmt;

	middle -= start;		     /* execution time in microsecs */

    #ifdef TCL_WIDE_CLICKS
	/* convert execution time in wide clicks to microsecs */
	middle *= TclpWideClickInMicrosec();
    #endif

	/* if not calibrate */
	if (!calibrate) {
	    /* minimize influence of measurement overhead */
	    if (overhead > 0) {
		/* estimate the time of overhead (microsecs) */
		Tcl_WideInt curOverhead = overhead * count;
		if (middle > curOverhead) {
		    middle -= curOverhead;
		} else {
		    middle = 1;
		}
	    }
	} else {
	    /* calibration - obtaining new measurement overhead */
	    if (measureOverhead > (double)middle / count) {
		measureOverhead = (double)middle / count;
	    }
	    objs[0] = Tcl_NewDoubleObj(measureOverhead);
	    TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
	    objs += 2;
	}

	val = middle / count;		     /* microsecs per iteration */
	if (val >= 1000000) {
	    objs[0] = Tcl_NewWideIntObj(val);
	} else {
	    if (val < 10)    { fmt = "%.6f"; } else
	    if (val < 100)   { fmt = "%.4f"; } else
	    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 < (0x7FFFFFFFFFFFFFFFL / 1000000)) {
	    val = (count * 1000000) / middle;
	    if (val < 100000) {
		if (val < 100)	{ fmt = "%.3f"; } else
		if (val < 1000) { fmt = "%.2f"; } else
				{ fmt = "%.1f"; };
		objs[4] = Tcl_ObjPrintf(fmt, ((double)(count * 1000000)) / middle);
	    } else {
		objs[4] = Tcl_NewWideIntObj(val);
	    }
	} else {
	    objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000);
	}

	/* estimated net execution time (in millisecs) */
	if (!calibrate) {
	    objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);
	    TclNewLiteralStringObj(objs[7], "nett-ms");
	}

	/*
	* Construct the result as a list because many programs have always parsed
	* as such (extracting the first element, typically).
	*/

	TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */
	TclNewLiteralStringObj(objs[3], "#");
	TclNewLiteralStringObj(objs[5], "#/sec");
	Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
    }

done:

    if (codePtr != NULL) {
	TclReleaseByteCode(codePtr);
    }

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WhileObjCmd --
 *
 *	This procedure is invoked to process the "while" Tcl command. See the

			    int objc, Tcl_Obj *const objv[],
			    CONST char *command, int length, int flags);
/*
 *----------------------------------------------------------------
 * Procedures exported by the engine to be used by tclBasic.c
 *----------------------------------------------------------------
 */

MODULE_SCOPE ByteCode *	TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const CmdFrame *invoker, int word);

MODULE_SCOPE int	TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const CmdFrame *invoker, int word);

/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl bytecode compilation and execution modules but

			    unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    CONST char *string, int maxChars);
MODULE_SCOPE int	TclRegisterLiteral(CompileEnv *envPtr,
			    char *bytes, int length, int flags);

static inline void
TclPreserveByteCode(
    register ByteCode *codePtr)
{
    codePtr->refCount++;
}

static inline void
TclReleaseByteCode(
    register ByteCode *codePtr)
{
    if (codePtr->refCount-- > 1) {
	return;
    }
    /* Just dropped to refcount==0.  Clean up. */
    TclCleanupByteCode(codePtr);
}

MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]);
MODULE_SCOPE int	TclSortingOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]);

    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileObj --
 *
 *  This procedure compiles the script contained in a Tcl_Obj.

 *
 * Results:



 *  A pointer to the corresponding ByteCode, never NULL.
 *
 * Side effects:

 *  The object is shimmered to bytecode type.
 *
 *----------------------------------------------------------------------
 */

ByteCode *
TclCompileObj(
    Tcl_Interp *interp, 
    Tcl_Obj *objPtr,
    const CmdFrame *invoker,
    int word)
{
    register Interp *iPtr = (Interp *) interp;
    register ByteCode *codePtr;	/* Tcl Internal type of bytecode. */

    Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
















    /*
     * If the object is not already of tclByteCodeType, compile it (and reset
     * the compilation flags in the interpreter; this should be done after any
     * compilation). Otherwise, check that it is "fresh" enough.
     */

	 */

	codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
	if (((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != namespacePtr)
		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
	    if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
		goto recompileObj;
	    }
	    if ((Interp *) *codePtr->interpHandle != iPtr) {
		Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;
	}

	/*
	 * Check that any compiled locals do refer to the current proc
	 * environment! If not, recompile.
	 */

	if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED) &&
		(codePtr->procPtr == NULL) &&
		(codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)){
	    goto recompileObj;

	}

	/*
	 * #280.
	 * Literal sharing fix. This part of the fix is not required by 8.4
	 * because it eval-directs any literals, so just saving the argument
	 * locations per command in bytecode is enough, embedded 'eval'

	 *     offset between saved starting line and actual one. Then modify
	 *     the users to adjust the locations they have by this offset.
	 *
	 * (3) Alternative 2: Do not fully recompile, adjust just the location
	 *     information.
	 */

	if (invoker == NULL) {
	    return codePtr;
	} else {
	    Tcl_HashEntry *hePtr =
		    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);


	    ExtCmdLoc *eclPtr;
	    CmdFrame *ctxCopyPtr;
	    int redo;

	    if (!hePtr) {
		return codePtr;
	    }

	    eclPtr = Tcl_GetHashValue(hePtr);
	    redo = 0;
	    ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame));
	    *ctxCopyPtr = *invoker;

	    if (invoker->type == TCL_LOCATION_BC) {
		/*
		 * Note: Type BC => ctx.data.eval.path    is not used.
		 *		    ctx.data.tebc.codePtr used instead
		 */

		TclGetSrcInfoForPc(ctxCopyPtr);
		if (ctxCopyPtr->type == TCL_LOCATION_SOURCE) {
		    /*
		     * The reference made by 'TclGetSrcInfoForPc' is dead.

		     */

		    Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
		    ctxCopyPtr->data.eval.path = NULL;
		}
	    }

	    if (word < ctxCopyPtr->nline) {
		/*
		 * Note: We do not care if the line[word] is -1. This is a
		 * difference and requires a recompile (location changed from
		 * absolute to relative, literal is used fixed and through
		 * variable)
		 *
		 * Example:
		 * test info-32.0 using literal of info-24.8
		 *     (dict with ... vs           set body ...).
		 */

		redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
			    && (eclPtr->start != ctxCopyPtr->line[word]))
			|| ((eclPtr->type == TCL_LOCATION_BC)
			    && (ctxCopyPtr->type == TCL_LOCATION_SOURCE));
	    }

	    TclStackFree(interp, ctxCopyPtr);

	    if (!redo) {




		return codePtr;




	    }






	}

    }

  recompileObj:
    iPtr->errorLine = 1;

    /*
     * TIP #280. Remember the invoker for a moment in the interpreter
     * structures so that the byte code compiler can pick it up when
     * initializing the compilation environment, i.e. the extended location
     * information.
     */

    iPtr->invokeCmdFramePtr = invoker;
    iPtr->invokeWord = word;
    TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
    iPtr->invokeCmdFramePtr = NULL;
    codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
    if (iPtr->varFramePtr->localCachePtr) {
	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	codePtr->localCachePtr->refCount++;
    }
    return codePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompEvalObj --
 *
 *	This procedure evaluates the script contained in a Tcl_Obj by first
 *	compiling it and then passing it to TclExecuteByteCode.
 *
 * Results:
 *	The return value is one of the return codes defined in tcl.h (such as
 *	TCL_OK), and interp->objResultPtr refers to a Tcl object that either
 *	contains the result of executing the code or an error message.
 *
 * Side effects:
 *	Almost certainly, depending on the ByteCode's instructions.
 *
 *----------------------------------------------------------------------
 */

int
TclCompEvalObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    const CmdFrame *invoker,
    int word)
{
    register Interp *iPtr = (Interp *) interp;
    register ByteCode *codePtr;	/* Tcl Internal type of bytecode. */
    int result;

    /*
     * Check that the interpreter is ready to execute scripts. Note that we
     * manage the interp's runlevel here: it is a small white lie (maybe), but
     * saves a ++/-- pair at each invocation. Amazingly enough, the impact on
     * performance is noticeable.
     */

    iPtr->numLevels++;
    if (TclInterpReady(interp) == TCL_ERROR) {
	result = TCL_ERROR;
	goto done;
    }

    /* Compile objPtr to the byte code */
    codePtr = TclCompileObj(interp, objPtr, invoker, word);

    /*
     * Increment the code's ref count while it is being executed. If
     * afterwards no references to it remain, free the code.
     */

    codePtr->refCount++;
    result = TclExecuteByteCode(interp, codePtr);
    codePtr->refCount--;
    if (codePtr->refCount <= 0) {
	TclCleanupByteCode(codePtr);
    }

  done:
    iPtr->numLevels--;
    return result;
}

/*
 *----------------------------------------------------------------------
 *

MODULE_SCOPE int	TclpLoadMemory(Tcl_Interp *interp, void *buffer,
			    int size, int codeSize, Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr);
#endif
MODULE_SCOPE void	TclInitThreadStorage(void);
MODULE_SCOPE void	TclpFinalizeThreadDataThread(void);
MODULE_SCOPE void	TclFinalizeThreadStorage(void);

#ifdef TCL_WIDE_CLICKS
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
MODULE_SCOPE double	TclpWideClickInMicrosec(void);
#else
#   ifdef _WIN32
#	define TCL_WIDE_CLICKS 1
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClickInMicrosec(void);
#	define		TclpWideClicksToNanoseconds(clicks) \
				((double)(clicks) * TclpWideClickInMicrosec() * 1000)
#   endif
#endif
MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);

MODULE_SCOPE Tcl_Obj *	TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
MODULE_SCOPE int TclUtfCasecmp(CONST char *cs, CONST char *ct);

/*
 *----------------------------------------------------------------
 * Command procedures in the generic core:
 *----------------------------------------------------------------

			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TellObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeRateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TraceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnloadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

if {![package vsatisfies [package provide Tcl] 8]} return
if {[info sharedlibextension] != ".dll"} return
if {[info exists ::tcl_platform(debug)]} {
  if {[info exists [file join $dir tclreg12g.dll]]} {
    package ifneeded registry 1.2.2 \
            [list load [file join $dir tclreg12g.dll] registry]
  } else {
    package ifneeded registry 1.2.2 \
            [list load tclreg12g registry]
  }
} else {
  if {[info exists [file join $dir tclreg12.dll]]} {
    package ifneeded registry 1.2.2 \
            [list load [file join $dir tclreg12.dll] registry]
  } else {
    package ifneeded registry 1.2.2 \
            [list load tclreg12 registry]
  }
}

{
    return time(NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetMicroseconds --
 *
 *	This procedure returns the number of microseconds from the epoch.
 *	On most Unix systems the epoch is Midnight Jan 1, 1970 GMT.
 *
 * Results:
 *	Number of microseconds from the epoch.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
TclpGetMicroseconds(void)
{
    Tcl_Time time;

    tclGetTimeProcPtr(&time, tclTimeClientData);
    return ((Tcl_WideInt)time.sec)*1000000 + time.usec;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetClicks --
 *
 *	This procedure returns a value that represents the highest resolution
 *	clock available on the system. There are no garantees on what the
 *	resolution will be. In Tcl we will call this value a "click". The
 *	start time is also system dependant.
 *

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

    return nsec;
}

/*
 *----------------------------------------------------------------------
 *
 * 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:
 *	None.
 *
 *----------------------------------------------------------------------
 */

double
TclpWideClickInMicrosec(void)
{
    if (tclGetTimeProcPtr != NativeGetTime) {
	return 1.0;
    } else {
#ifdef MAC_OSX_TCL
	static int initialized = 0;
	static double scale = 0.0;

	if (initialized) {
	    return scale;
	} else {
	    mach_timebase_info_data_t tb;

	    mach_timebase_info(&tb);
	    /* value of tb.numer / tb.denom = 1 click in nanoseconds */
	    scale = ((double)tb.numer) / tb.denom / 1000;
	    initialized = 1;
	    return scale;
	}
#else
#error Wide high-resolution clicks not implemented on this platform
#endif
    }
}
#endif /* TCL_WIDE_CLICKS */

/*
 *----------------------------------------------------------------------
 *
 * TclpGetTimeZone --
 *

    0,
    0,
#endif
    { 0 },
    { 0 },
    0
};

/*
 * Scale to convert wide click values from the TclpGetWideClicks native
 * resolution to microsecond resolution and back.
 */
static struct {
    int initialized;		/* 1 if initialized, 0 otherwise */
    int perfCounter;		/* 1 if performance counter usable for wide clicks */
    double microsecsScale;	/* Denominator scale between clock / microsecs */
} wideClick = {0, 0.0};


/*
 * Declarations for functions defined later in this file.
 */

static struct tm *	ComputeGMT(const time_t *tp);
static void		StopCalibration(ClientData clientData);
static DWORD WINAPI	CalibrationThread(LPVOID arg);
static void 		UpdateTimeEachSecond(void);
static void		ResetCounterSamples(Tcl_WideUInt fileTime,
			    Tcl_WideInt perfCounter, Tcl_WideInt perfFreq);
static Tcl_WideInt	AccumulateSample(Tcl_WideInt perfCounter,
			    Tcl_WideUInt fileTime);
static void		NativeScaleTime(Tcl_Time* timebuf,
			    ClientData clientData);
static Tcl_WideInt	NativeGetMicroseconds(void);
static void		NativeGetTime(Tcl_Time* timebuf,
			    ClientData clientData);

/*
 * TIP #233 (Virtualized Time): Data for the time hooks, if any.
 */

 *
 *----------------------------------------------------------------------
 */

unsigned long
TclpGetSeconds(void)
{
    Tcl_WideInt usecSincePosixEpoch;

    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
    ) {
	return usecSincePosixEpoch / 1000000;
    } else {
	Tcl_Time t;

	tclGetTimeProcPtr(&t, tclTimeClientData);	/* Tcl_GetTime inlined. */
	return t.sec;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetClicks --
 *

 *
 *----------------------------------------------------------------------
 */

unsigned long
TclpGetClicks(void)
{
    Tcl_WideInt usecSincePosixEpoch;

    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
    ) {
	return (unsigned long)usecSincePosixEpoch;
    } else {
	/*
	* Use the Tcl_GetTime abstraction to get the time in microseconds, as
	* nearly as we can, and return it.
	*/

	Tcl_Time now;		/* Current Tcl time */

	tclGetTimeProcPtr(&now, tclTimeClientData);	/* Tcl_GetTime inlined */
	return (unsigned long)(now.sec * 1000000) + now.usec;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetWideClicks --
 *
 *	This procedure returns a WideInt value that represents the highest
 *	resolution clock in microseconds available on the system.
 *
 * Results:
 *	Number of microseconds (from some start time).
 *
 * Side effects:
 *	This should be used for time-delta resp. for measurement purposes
 *	only, because on some platforms can return microseconds from some
 *	start time (not from the epoch).
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
TclpGetWideClicks(void)
{
    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 */
	wideClick.perfCounter = 0;
	wideClick.microsecsScale = 1;
	return TclpGetMicroseconds();
    } else {
    	return TclpGetMicroseconds();
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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:
 *	None.
 *
 *----------------------------------------------------------------------
 */

double
TclpWideClickInMicrosec(void)
{
    if (!wideClick.initialized) {
    	(void)TclpGetWideClicks();	/* initialize */
    }
    return wideClick.microsecsScale;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetMicroseconds --
 *
 *	This procedure returns a WideInt value that represents the highest
 *	resolution clock in microseconds available on the system.
 *
 * Results:
 *	Number of microseconds (from the epoch).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt 
TclpGetMicroseconds(void)
{
    Tcl_WideInt usecSincePosixEpoch;

    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
    ) {
	return usecSincePosixEpoch;
    } else {
	/*
	* Use the Tcl_GetTime abstraction to get the time in microseconds, as
	* nearly as we can, and return it.
	*/

	Tcl_Time now;

	tclGetTimeProcPtr(&now, tclTimeClientData);	/* Tcl_GetTime inlined */
	return (((Tcl_WideInt)now.sec) * 1000000) + now.usec;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetTimeZone --
 *

 *----------------------------------------------------------------------
 */

void
Tcl_GetTime(
    Tcl_Time *timePtr)		/* Location to store time information. */
{
    Tcl_WideInt usecSincePosixEpoch;

    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
    ) {
	timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
	timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
    } else {
    	tclGetTimeProcPtr(timePtr, tclTimeClientData);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * NativeScaleTime --
 *

     * Native scale is 1:1. Nothing is done.
     */
}

/*
 *----------------------------------------------------------------------
 *
 * NativeGetMicroseconds --
 *
 *	Gets the current system time in microseconds since the beginning
 *	of the epoch: 00:00 UCT, January 1, 1970.
 *
 * Results:
 *	Returns the wide integer with number of microseconds from the epoch, or
 *	0 if high resolution timer is not available.
 *
 * Side effects:
 *	On the first call, initializes a set of static variables to keep track
 *	of the base value of the performance counter, the corresponding wall
 *	clock (obtained through ftime) and the frequency of the performance
 *	counter. Also spins a thread whose function is to wake up periodically
 *	and monitor these values, adjusting them as necessary to correct for
 *	drift in the performance counter's oscillator.
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
NativeGetMicroseconds(void)


{

    static LARGE_INTEGER posixEpoch;
				/* Posix epoch expressed as 100-ns ticks since
				 * the windows epoch. */
    /*
     * Initialize static storage on the first trip through.
     *
     * Note: Outer check for 'initialized' is a performance win since it
     * avoids an extra mutex lock in the common case.
     */

    if (!timeInfo.initialized) {
	TclpInitLock();
	if (!timeInfo.initialized) {

	    posixEpoch.LowPart = 0xD53E8000;
	    posixEpoch.HighPart = 0x019DB1DE;

	    timeInfo.perfCounterAvailable =
		    QueryPerformanceFrequency(&timeInfo.nominalFreq);

	    /*
	     * Some hardware abstraction layers use the CPU clock in place of
	     * the real-time clock as a performance counter reference. This
	     * results in:

	LARGE_INTEGER perfCounterLastCall, curCounterFreq;
				/* Copy with current data of calibration cycle */

	LARGE_INTEGER curCounter;
				/* Current performance counter. */
	Tcl_WideInt curFileTime;/* Current estimated time, expressed as 100-ns
				 * ticks since the Windows epoch. */



	Tcl_WideInt usecSincePosixEpoch;
				/* Current microseconds since Posix epoch. */




	QueryPerformanceCounter(&curCounter);

	/*
	 * Hold time section locked as short as possible
	 */
	EnterCriticalSection(&timeInfo.cs);

	fileTimeLastCall.QuadPart = timeInfo.fileTimeLastCall.QuadPart;
	perfCounterLastCall.QuadPart = timeInfo.perfCounterLastCall.QuadPart;
	curCounterFreq.QuadPart = timeInfo.curCounterFreq.QuadPart;

	LeaveCriticalSection(&timeInfo.cs);

	/*
	 * If calibration cycle occurred after we get curCounter
	 */
	if (curCounter.QuadPart <= perfCounterLastCall.QuadPart) {
	    usecSincePosixEpoch =
		(fileTimeLastCall.QuadPart - posixEpoch.QuadPart) / 10;


	    return usecSincePosixEpoch;
	}

	/*
	 * If it appears to be more than 1.1 seconds since the last trip
	 * through the calibration loop, the performance counter may have
	 * jumped forward. (See MSDN Knowledge Base article Q274323 for a
	 * description of the hardware problem that makes this test
	 * necessary.) If the counter jumps, we don't want to use it directly.
	 * Instead, we must return system time. Eventually, the calibration
	 * loop should recover.
	 */

	if (curCounter.QuadPart - perfCounterLastCall.QuadPart <
		11 * curCounterFreq.QuadPart / 10
	) {
	    curFileTime = fileTimeLastCall.QuadPart +
		 ((curCounter.QuadPart - perfCounterLastCall.QuadPart)
		    * 10000000 / curCounterFreq.QuadPart);

	    usecSincePosixEpoch = (curFileTime - posixEpoch.QuadPart) / 10;
	    return usecSincePosixEpoch;
	}
    }

    /*
     * High resolution timer is not available.
     */
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * NativeGetTime --
 *
 *	TIP #233: 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.
 *
 * Side effects:
 *	See NativeGetMicroseconds for more information.
 *
 *----------------------------------------------------------------------
 */

static void
NativeGetTime(
    Tcl_Time *timePtr,
    ClientData clientData)
{
    Tcl_WideInt usecSincePosixEpoch;

    /*
     * Try to use high resolution timer.
     */
    if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) {
	timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
	timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
    } else {
	/*
	* High resolution timer is not available. Just use ftime.
	*/

	struct _timeb t;

	_ftime(&t);
	timePtr->sec = (long)t.time;
	timePtr->usec = t.millitm * 1000;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * StopCalibration --
 *