summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h2
-rw-r--r--generic/tclBasic.c10
-rw-r--r--generic/tclCmdAH.c13
-rw-r--r--generic/tclCmdMZ.c21
-rw-r--r--generic/tclDTrace.d57
-rw-r--r--generic/tclExecute.c22
-rw-r--r--generic/tclInt.h2
-rw-r--r--generic/tclStubInit.c2
-rw-r--r--generic/tclTomMath.decls2
-rw-r--r--generic/tclTomMathDecls.h5
10 files changed, 73 insertions, 63 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index 17ab2d3..2077a32 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -440,7 +440,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
#if defined(_WIN32)
# ifdef __BORLANDC__
typedef struct stati64 Tcl_StatBuf;
-# elif defined(_WIN64)
+# elif defined(_WIN64) || defined(__MINGW_USE_VC2005_COMPAT) || defined(_USE_64BIT_TIME_T)
typedef struct __stat64 Tcl_StatBuf;
# elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T)
typedef struct _stati64 Tcl_StatBuf;
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 31fa279..62e7e04 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -484,7 +484,15 @@ Tcl_CreateInterp(void)
Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame");
}
-#if defined(_WIN32) && !defined(_WIN64)
+#if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T) \
+ && !defined(__MINGW_USE_VC2005_COMPAT)
+ /* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T or
+ * -D__MINGW_USE_VC2005_COMPAT, the result is a binary incompatible
+ * with the 'standard' build of Tcl: All extensions using Tcl_StatBuf
+ * or interal functions like TclpGetDate() need to be recompiled in
+ * the same way. Therefore, this is not officially supported.
+ * In stead, it is recommended to use Win64 or Tcl 9.0 (not released yet)
+ */
if (sizeof(time_t) != 4) {
/*NOTREACHED*/
Tcl_Panic("<time.h> is not compatible with MSVC");
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 8a269ec..40a10ba 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -1392,14 +1392,9 @@ FileAttrAccessTimeCmd(
#endif
if (objc == 3) {
- /*
- * Need separate variable for reading longs from an object on 64-bit
- * platforms. [Bug 698146]
- */
-
- long newTime;
+ Tcl_WideInt newTime;
- if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
return TCL_ERROR;
}
@@ -1478,9 +1473,9 @@ FileAttrModifyTimeCmd(
* platforms. [Bug 698146]
*/
- long newTime;
+ Tcl_WideInt newTime;
- if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
return TCL_ERROR;
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index b4283d0..1cb27fc 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -4328,7 +4328,6 @@ Tcl_TimeRateObjCmd(
};
NRE_callback *rootPtr;
ByteCode *codePtr = NULL;
- int codeOptimized = 0;
for (i = 1; i < objc - 1; i++) {
int index;
@@ -4513,15 +4512,6 @@ Tcl_TimeRateObjCmd(
}
codePtr = TclCompileObj(interp, objPtr, NULL, 0);
TclPreserveByteCode(codePtr);
- /*
- * Replace last compiled done instruction with continue: it's a part of
- * iteration, this way evaluation will be more similar to a cycle (also
- * avoids extra overhead to set result to interp, etc.)
- */
- if (codePtr->codeStart[codePtr->numCodeBytes-1] == INST_DONE) {
- codePtr->codeStart[codePtr->numCodeBytes-1] = INST_CONTINUE;
- codeOptimized = 1;
- }
}
/*
@@ -4563,6 +4553,12 @@ Tcl_TimeRateObjCmd(
count++;
if (!direct) { /* precompiled */
rootPtr = TOP_CB(interp);
+ /*
+ * Use loop optimized TEBC call (TCL_EVAL_DISCARD_RESULT): it's a part of
+ * iteration, this way evaluation will be more similar to a cycle (also
+ * avoids extra overhead to set result to interp, etc.)
+ */
+ ((Interp *)interp)->evalFlags |= TCL_EVAL_DISCARD_RESULT;
result = TclNRExecuteByteCode(interp, codePtr);
result = TclNRRunCallbacks(interp, result, rootPtr);
} else { /* eval */
@@ -4815,11 +4811,6 @@ Tcl_TimeRateObjCmd(
done:
if (codePtr != NULL) {
- if ( codeOptimized
- && codePtr->codeStart[codePtr->numCodeBytes-1] == INST_CONTINUE
- ) {
- codePtr->codeStart[codePtr->numCodeBytes-1] = INST_DONE;
- }
TclReleaseByteCode(codePtr);
}
return result;
diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d
index 360bdff..f5493b1 100644
--- a/generic/tclDTrace.d
+++ b/generic/tclDTrace.d
@@ -10,7 +10,6 @@
*/
typedef struct Tcl_Obj Tcl_Obj;
-typedef const char* TclDTraceStr;
/*
* Tcl DTrace probes
@@ -25,14 +24,14 @@ provider tcl {
* arg1: number of arguments (int)
* arg2: array of proc argument objects (Tcl_Obj**)
*/
- probe proc__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv);
+ probe proc__entry(const char *name, int objc, struct Tcl_Obj **objv);
/*
* tcl*:::proc-return probe
* triggered immediately after proc bytecode execution
* arg0: proc name (string)
* arg1: return code (int)
*/
- probe proc__return(TclDTraceStr name, int code);
+ probe proc__return(const char *name, int code);
/*
* tcl*:::proc-result probe
* triggered after proc-return probe and result processing
@@ -41,7 +40,7 @@ provider tcl {
* arg2: proc result (string)
* arg3: proc result object (Tcl_Obj*)
*/
- probe proc__result(TclDTraceStr name, int code, TclDTraceStr result,
+ probe proc__result(const char *name, int code, const char *result,
struct Tcl_Obj *resultobj);
/*
* tcl*:::proc-args probe
@@ -50,10 +49,10 @@ provider tcl {
* arg0: proc name (string)
* arg1-arg9: proc arguments or NULL (strings)
*/
- probe proc__args(TclDTraceStr name, TclDTraceStr arg1, TclDTraceStr arg2,
- TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5,
- TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8,
- TclDTraceStr arg9);
+ probe proc__args(const char *name, const char *arg1, const char *arg2,
+ const char *arg3, const char *arg4, const char *arg5,
+ const char *arg6, const char *arg7, const char *arg8,
+ const char *arg9);
/*
* tcl*:::proc-info probe
* triggered before proc-entry probe, gives access to TIP 280
@@ -67,9 +66,9 @@ provider tcl {
* arg6: TclOO method (string)
* arg7: TclOO class/object (string)
*/
- probe proc__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc,
- TclDTraceStr file, int line, int level, TclDTraceStr method,
- TclDTraceStr class);
+ probe proc__info(const char *cmd, const char *type, const char *proc,
+ const char *file, int line, int level, const char *method,
+ const char *class);
/***************************** cmd probes ******************************/
/*
@@ -79,14 +78,14 @@ provider tcl {
* arg1: number of arguments (int)
* arg2: array of command argument objects (Tcl_Obj**)
*/
- probe cmd__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv);
+ probe cmd__entry(const char *name, int objc, struct Tcl_Obj **objv);
/*
* tcl*:::cmd-return probe
* triggered immediately after commmand execution
* arg0: command name (string)
* arg1: return code (int)
*/
- probe cmd__return(TclDTraceStr name, int code);
+ probe cmd__return(const char *name, int code);
/*
* tcl*:::cmd-result probe
* triggered after cmd-return probe and result processing
@@ -95,7 +94,7 @@ provider tcl {
* arg2: command result (string)
* arg3: command result object (Tcl_Obj*)
*/
- probe cmd__result(TclDTraceStr name, int code, TclDTraceStr result,
+ probe cmd__result(const char *name, int code, const char *result,
struct Tcl_Obj *resultobj);
/*
* tcl*:::cmd-args probe
@@ -104,10 +103,10 @@ provider tcl {
* arg0: command name (string)
* arg1-arg9: command arguments or NULL (strings)
*/
- probe cmd__args(TclDTraceStr name, TclDTraceStr arg1, TclDTraceStr arg2,
- TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5,
- TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8,
- TclDTraceStr arg9);
+ probe cmd__args(const char *name, const char *arg1, const char *arg2,
+ const char *arg3, const char *arg4, const char *arg5,
+ const char *arg6, const char *arg7, const char *arg8,
+ const char *arg9);
/*
* tcl*:::cmd-info probe
* triggered before cmd-entry probe, gives access to TIP 280
@@ -121,9 +120,9 @@ provider tcl {
* arg6: TclOO method (string)
* arg7: TclOO class/object (string)
*/
- probe cmd__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc,
- TclDTraceStr file, int line, int level, TclDTraceStr method,
- TclDTraceStr class);
+ probe cmd__info(const char *cmd, const char *type, const char *proc,
+ const char *file, int line, int level, const char *method,
+ const char *class);
/***************************** inst probes *****************************/
/*
@@ -133,7 +132,7 @@ provider tcl {
* arg1: depth of stack (int)
* arg2: top of stack (Tcl_Obj**)
*/
- probe inst__start(TclDTraceStr name, int depth, struct Tcl_Obj **stack);
+ probe inst__start(const char *name, int depth, struct Tcl_Obj **stack);
/*
* tcl*:::inst-done probe
* triggered immediately after execution of a bytecode
@@ -141,7 +140,7 @@ provider tcl {
* arg1: depth of stack (int)
* arg2: top of stack (Tcl_Obj**)
*/
- probe inst__done(TclDTraceStr name, int depth, struct Tcl_Obj **stack);
+ probe inst__done(const char *name, int depth, struct Tcl_Obj **stack);
/***************************** obj probes ******************************/
/*
@@ -163,10 +162,10 @@ provider tcl {
* triggered when the ::tcl::dtrace command is called
* arg0-arg9: command arguments (strings)
*/
- probe tcl__probe(TclDTraceStr arg0, TclDTraceStr arg1, TclDTraceStr arg2,
- TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5,
- TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8,
- TclDTraceStr arg9);
+ probe tcl__probe(const char *arg0, const char *arg1, const char *arg2,
+ const char *arg3, const char *arg4, const char *arg5,
+ const char *arg6, const char *arg7, const char *arg8,
+ const char *arg9);
};
/*
@@ -174,7 +173,7 @@ provider tcl {
*/
typedef struct Tcl_ObjType {
- char *name;
+ const char *name;
void *freeIntRepProc;
void *dupIntRepProc;
void *updateStringProc;
@@ -185,7 +184,7 @@ struct Tcl_Obj {
int refCount;
char *bytes;
int length;
- Tcl_ObjType *typePtr;
+ const Tcl_ObjType *typePtr;
union {
long longValue;
double doubleValue;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index cdf0c5d..06c3ecd 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2086,7 +2086,14 @@ TclNRExecuteByteCode(
*/
TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
- /* cleanup */ INT2PTR(0), NULL);
+ /* cleanup */ INT2PTR(0), INT2PTR(iPtr->evalFlags));
+
+ /*
+ * Reset discard result flag - because it is applicable for this call only,
+ * and should not affect all the nested invocations may return result.
+ */
+ iPtr->evalFlags &= ~TCL_EVAL_DISCARD_RESULT;
+
return TCL_OK;
}
@@ -2142,6 +2149,7 @@ TEBCresume(
#define auxObjList (TD->auxObjList)
#define catchTop (TD->catchTop)
#define codePtr (TD->codePtr)
+#define curEvalFlags PTR2INT(data[3]) /* calling iPtr->evalFlags */
/*
* Globals: variables that store state, must remain valid at all times.
@@ -2624,6 +2632,14 @@ TEBCresume(
case INST_DONE:
if (tosPtr > initTosPtr) {
+
+ if ((curEvalFlags & TCL_EVAL_DISCARD_RESULT) && (result == TCL_OK)) {
+ /* simulate pop & fast done (like it does continue in loop) */
+ TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
+ objPtr = POP_OBJECT();
+ TclDecrRefCount(objPtr);
+ goto abnormalReturn;
+ }
/*
* Set the interpreter's object result to point to the topmost
* object from the stack, and check for a possible [catch]. The
@@ -8084,7 +8100,7 @@ TEBCresume(
*/
/*
- * Abnormal return code. Restore the stack to state it had when
+ * Done or abnormal return code. Restore the stack to state it had when
* starting to execute the ByteCode. Panic if the stack is below the
* initial level.
*/
@@ -9001,7 +9017,7 @@ ExecuteExtendedBinaryMathOp(
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
mp_init(&bigResult);
- mp_expt_d(&big1, (mp_digit)w2, &bigResult);
+ mp_expt_u32(&big1, (unsigned int)w2, &bigResult);
mp_clear(&big1);
BIG_RESULT(&bigResult);
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7b2055c..62fd71b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2206,6 +2206,7 @@ typedef struct Interp {
#define TCL_EVAL_FILE 0x02
#define TCL_EVAL_SOURCE_IN_FRAME 0x10
#define TCL_EVAL_NORESOLVE 0x20
+#define TCL_EVAL_DISCARD_RESULT 0x40
/*
* Flag bits for Interp structures:
@@ -4071,7 +4072,6 @@ MODULE_SCOPE int TclIndexDecode(int encoded, int endValue);
#ifdef USE_DTRACE
#ifndef _TCLDTRACE_H
-typedef const char *TclDTraceStr;
#include "tclDTrace.h"
#endif
#define TCL_DTRACE_OBJ_CREATE(objPtr) TCL_OBJ_CREATE(objPtr)
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 313b2cb..20142cd 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -91,7 +91,7 @@ int TclBN_mp_init_set_int(mp_int *a, unsigned long i)
int TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast)
{
- return mp_expt_d(a, b, c);
+ return mp_expt_u32(a, b, c);
}
#define TclSetStartupScriptPath setStartupScriptPath
diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls
index 21e2b39..a73dc2d 100644
--- a/generic/tclTomMath.decls
+++ b/generic/tclTomMath.decls
@@ -81,7 +81,7 @@ declare 18 {
void TclBN_mp_exch(mp_int *a, mp_int *b)
}
declare 19 {
- int TclBN_mp_expt_d(const mp_int *a, mp_digit b, mp_int *c)
+ int TclBN_mp_expt_d(const mp_int *a, unsigned int b, mp_int *c)
}
declare 20 {
int TclBN_mp_grow(mp_int *a, int size)
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
index 7b0ebfe..6953c9d 100644
--- a/generic/tclTomMathDecls.h
+++ b/generic/tclTomMathDecls.h
@@ -70,6 +70,7 @@
#define mp_exch TclBN_mp_exch
#define mp_expt_d TclBN_mp_expt_d
#define mp_expt_d_ex TclBN_mp_expt_d_ex
+#define mp_expt_u32 TclBN_mp_expt_d
#define mp_get_bit TclBN_mp_get_bit
#define s_mp_get_bit TclBN_mp_get_bit
#define mp_grow TclBN_mp_grow
@@ -196,7 +197,7 @@ EXTERN int TclBN_mp_div_3(const mp_int *a, mp_int *q,
/* 18 */
EXTERN void TclBN_mp_exch(mp_int *a, mp_int *b);
/* 19 */
-EXTERN int TclBN_mp_expt_d(const mp_int *a, mp_digit b,
+EXTERN int TclBN_mp_expt_d(const mp_int *a, unsigned int b,
mp_int *c);
/* 20 */
EXTERN int TclBN_mp_grow(mp_int *a, int size);
@@ -359,7 +360,7 @@ typedef struct TclTomMathStubs {
int (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r); /* 16 */
int (*tclBN_mp_div_3) (const mp_int *a, mp_int *q, mp_digit *r); /* 17 */
void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */
- int (*tclBN_mp_expt_d) (const mp_int *a, mp_digit b, mp_int *c); /* 19 */
+ int (*tclBN_mp_expt_d) (const mp_int *a, unsigned int b, mp_int *c); /* 19 */
int (*tclBN_mp_grow) (mp_int *a, int size); /* 20 */
int (*tclBN_mp_init) (mp_int *a); /* 21 */
int (*tclBN_mp_init_copy) (mp_int *a, const mp_int *b); /* 22 */
generated by cgit v0.12 at 2024-11-16 04:38:24 (GMT)