From 9c28e9130dec0dfd158406aa5997ed811e5f699d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 6 May 2013 06:52:53 +0000 Subject: 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. --- ChangeLog | 9 ++++++ generic/tclDecls.h | 48 +++++++++++++++++++++++++++++ generic/tclStubInit.c | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 142 insertions(+) diff --git a/ChangeLog b/ChangeLog index 11ecbf8..e200cd0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2013-05-06 Jan Nijtmans + + * generic/tclStubInit.c: Add support for Cygwin64, which has a 64-bit + * generic/tclDecls.h: "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. + 2013-04-30 Andreas Kupries * library/platform/platform.tcl (::platform::LibcVersion): 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 -- cgit v0.12