summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2013-05-06 06:52:53 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2013-05-06 06:52:53 (GMT)
commit9c28e9130dec0dfd158406aa5997ed811e5f699d (patch)
treef0eec0a6caca58ebfc415ac257ad3226eed0e409 /generic
parent9e8ba3b5d77ed44876e3454cbf88fff15687c610 (diff)
downloadtcl-9c28e9130dec0dfd158406aa5997ed811e5f699d.zip
tcl-9c28e9130dec0dfd158406aa5997ed811e5f699d.tar.gz
tcl-9c28e9130dec0dfd158406aa5997ed811e5f699d.tar.bz2
Add support for Cygwin64, which has a 64-bit "long" type.
Binary compatibility with win64 requires that all stub entries use 32-bit long's, therefore the need for various wrapper functions/macros. For Tcl 9 a better solution is needed, but that cannot be done without introducing binary incompatibility.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclDecls.h48
-rw-r--r--generic/tclStubInit.c85
2 files changed, 133 insertions, 0 deletions
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 813c75c..cbfa8ee 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -4551,6 +4551,54 @@ extern TclStubs *tclStubsPtr;
#define Tcl_UpVar(interp, frameName, varName, localName, flags) \
Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags)
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
+# if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
+/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
+ * we have to make sure that all stub entries on Cygwin64 follow the
+ * Win64 signature. Cygwin64 stubbed extensions cannot use those stub
+ * entries any more, they should use the 64-bit alternatives where
+ * possible. Tcl 9 must find a better solution, but that cannot be done
+ * without introducing a binary incompatibility.
+ */
+# undef Tcl_DbNewLongObj
+# undef Tcl_GetLongFromObj
+# undef Tcl_NewLongObj
+# undef Tcl_SetLongObj
+# undef Tcl_ExprLong
+# undef Tcl_ExprLongObj
+# undef Tcl_UniCharNcmp
+# undef Tcl_UtfNcmp
+# undef Tcl_UtfNcasecmp
+# undef Tcl_UniCharNcasecmp
+# define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj)
+# define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj)
+# define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj)
+# define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))Tcl_SetWideIntObj)
+# define Tcl_ExprLong TclExprLong
+ static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){
+ int intValue;
+ int result = tclStubsPtr->tcl_ExprLong(interp, string, (long *)&intValue);
+ if (result == TCL_OK) *ptr = (long)intValue;
+ return result;
+ }
+# define Tcl_ExprLongObj TclExprLongObj
+ static inline int TclExprLongObj(Tcl_Interp *interp, Tcl_Obj *obj, long *ptr){
+ int intValue;
+ int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue);
+ if (result == TCL_OK) *ptr = (long)intValue;
+ return result;
+ }
+# define Tcl_UniCharNcmp(ucs,uct,n) \
+ ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n))
+# define Tcl_UtfNcmp(s1,s2,n) \
+ ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n))
+# define Tcl_UtfNcasecmp(s1,s2,n) \
+ ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n))
+# define Tcl_UniCharNcasecmp(ucs,uct,n) \
+ ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n))
+# endif
+#endif
+
/*
* Deprecated Tcl procedures:
*/
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 85dfe1c..d796136 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -189,6 +189,91 @@ Tcl_WinTCharToUtf(
string, len, dsPtr);
}
+#if defined(TCL_WIDE_INT_IS_LONG)
+/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
+ * we have to make sure that all stub entries on Cygwin64 follow the Win64
+ * signature. Tcl 9 must find a better solution, but that cannot be done
+ * without introducing a binary incompatibility.
+ */
+#define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))dbNewLongObj)
+static Tcl_Obj *dbNewLongObj(
+ int intValue,
+ const char *file,
+ int line
+) {
+#ifdef TCL_MEM_DEBUG
+ register Tcl_Obj *objPtr;
+
+ TclDbNewObj(objPtr, file, line);
+ objPtr->bytes = NULL;
+
+ objPtr->internalRep.longValue = (long) intValue;
+ objPtr->typePtr = &tclIntType;
+ return objPtr;
+#else
+ return Tcl_NewIntObj(intValue);
+#endif
+}
+#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetIntFromObj
+#define Tcl_NewLongObj (Tcl_Obj*(*)(long))Tcl_NewIntObj
+#define Tcl_SetLongObj (void(*)(Tcl_Obj*,long))Tcl_SetIntObj
+static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
+ long longValue;
+ int result = Tcl_ExprLong(interp, expr, &longValue);
+ if (result == TCL_OK) {
+ if ((longValue >= -(long)(UINT_MAX))
+ && (longValue <= (long)(UINT_MAX))) {
+ *ptr = (int)longValue;
+ } else {
+ Tcl_SetResult(interp,
+ "integer value too large to represent as non-long integer",
+ TCL_STATIC);
+ result = TCL_ERROR;
+ }
+ }
+ return result;
+}
+#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))exprInt
+static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
+ long longValue;
+ int result = Tcl_ExprLongObj(interp, expr, &longValue);
+ if (result == TCL_OK) {
+ if ((longValue >= -(long)(UINT_MAX))
+ && (longValue <= (long)(UINT_MAX))) {
+ *ptr = (int)longValue;
+ } else {
+ Tcl_SetResult(interp,
+ "integer value too large to represent as non-long integer",
+ TCL_STATIC);
+ result = TCL_ERROR;
+ }
+ }
+ return result;
+}
+#define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj
+static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
+ return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n);
+}
+#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcmp
+static int utfNcmp(const char *s1, const char *s2, unsigned int n){
+ return Tcl_UtfNcmp(s1, s2, (unsigned long)n);
+}
+#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))utfNcmp
+static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){
+ return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n);
+}
+#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))utfNcasecmp
+static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
+ return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n);
+}
+#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp
+static int formatInt(char *buffer, int n){
+ return TclFormatInt(buffer, (long)n);
+}
+#define TclFormatInt (int(*)(char *, long))formatInt
+
+#endif
+
#else /* UNIX and MAC */
# define TclpGetPid 0
# define TclpLocaltime_unix TclpLocaltime