instead of unions use double cast for data pointer <-> function pointer

Message-ID: <42A7D8C0.1080104@gmail.com>

p4raw-id: //depot/perl@24770

4 files changed, 28 insertions, 42 deletions

diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs
index 475112a684..5978bfd037 100644
--- a/ext/DynaLoader/dl_dlopen.xs
+++ b/ext/DynaLoader/dl_dlopen.xs
@@ -248,18 +248,11 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *		symref 
     char *		filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
-		perl_name, (unsigned long) symref));
-#if defined(__DECC) && defined(__osf__)
-#pragma message save
-#pragma message disable (nonstandcast) /* Avoid symref cast warning. */
-#endif
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%"UVxf")\n",
+		perl_name, PTR2UV(symref)));
     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
-					(void(*)(pTHX_ CV *))symref,
+					DPTR2FPTR(XSUBADDR_t, symref),
 					filename)));
-#if defined(__DECC) && defined(__osf__)
-#pragma message restore
-#endif
 
 
 char *
diff --git a/perl.h b/perl.h
index 71d8180d06..3df67ebf71 100644
--- a/perl.h
+++ b/perl.h
@@ -1495,6 +1495,19 @@ typedef UVTYPE UV;
 #  define PTR2ul(p)	INT2PTR(unsigned long,p)	
 #endif
 
+/* According to strict ANSI C89 one cannot freely cast between
+ * data pointers and function (code) pointers.  There are at least
+ * two ways around this.  One (used below) is to do two casts,
+ * first the other pointer to an (unsigned) integer, and then
+ * the integer to the other pointer.  The other way would be
+ * to use unions to "overlay" the pointers.  For an example of
+ * the latter technique, see union dirpu in struct xpvio in sv.h.
+ * The only feasible use is probably temporarily storing
+ * function pointers in a data pointer (such as a void pointer). */
+
+#define DPTR2FPTR(t,p) ((t)PTR2UV(p)) /* data pointer to function pointer */
+#define FPTR2DPTR(t,p) ((t)PTR2UV(p)) /* function pointer to data pointer */
+
 #ifdef USE_LONG_DOUBLE
 #  if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE
 #      define LONG_DOUBLE_EQUALS_DOUBLE
diff --git a/sv.c b/sv.c
index f6877f4c5a..b5b55221d1 100644
--- a/sv.c
+++ b/sv.c
@@ -11309,9 +11309,6 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
     void (*dptr) (void*);
     void (*dxptr) (pTHX_ void*);
     OP *o;
-    /* Unions for circumventing strict ANSI C89 casting rules. */
-    union { void *vptr; void (*dptr)(void*); } u1, u2;
-    union { void *vptr; void (*dxptr)(pTHX_ void*); } u3, u4;
 
     Newz(54, nss, max, ANY);
 
@@ -11483,17 +11480,17 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 	    ptr = POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);	/* XXX quite arbitrary */
 	    dptr = POPDPTR(ss,ix);
-	    u1.dptr = dptr;
-	    u2.vptr = any_dup(u1.vptr, proto_perl);
-	    TOPDPTR(nss,ix) = u2.dptr;
+	    TOPDPTR(nss,ix) = DPTR2FPTR(void (*)(void*),
+					any_dup(FPTR2DPTR(void *, dptr),
+						proto_perl));
 	    break;
 	case SAVEt_DESTRUCTOR_X:
 	    ptr = POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);	/* XXX quite arbitrary */
 	    dxptr = POPDXPTR(ss,ix);
-	    u3.dxptr = dxptr;
-	    u4.vptr = any_dup(u3.vptr, proto_perl);;
-	    TOPDXPTR(nss,ix) = u4.dxptr;
+	    TOPDXPTR(nss,ix) = DPTR2FPTR(void (*)(pTHX_ void*),
+					 any_dup(FPTR2DPTR(void *, dxptr),
+						 proto_perl));
 	    break;
 	case SAVEt_REGCONTEXT:
 	case SAVEt_ALLOC:
diff --git a/toke.c b/toke.c
index d962e3cc9e..e4350c1fcb 100644
--- a/toke.c
+++ b/toke.c
@@ -107,15 +107,6 @@ static const char* const lex_state_names[] = {
 #endif
 #define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline))
 
-/* According to some strict interpretations of ANSI C89 one cannot
- * cast void pointers to code pointers or vice versa (as filter_add(),
- * filter_del(), and filter_read() will want to do).  We should still
- * be able to use a union for sneaky "casting". */
-typedef union {
-    XPVIO*   iop;
-    filter_t filter;
-} xpvio_filter_u;
-
 /*
  * Convenience functions to return different tokens and prime the
  * lexer for the next token.  They all take an argument.
@@ -2141,8 +2132,6 @@ S_incl_perldb(pTHX)
 SV *
 Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
 {
-    xpvio_filter_u u;
-
     if (!funcp)
 	return Nullsv;
 
@@ -2151,11 +2140,10 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
     if (!datasv)
 	datasv = NEWSV(255,0);
     SvUPGRADE(datasv, SVt_PVIO);
-    u.filter = funcp;
-    IoANY(datasv) = u.iop; /* stash funcp into spare field */
+    IoANY(datasv) = FPTR2DPTR(void *, funcp); /* stash funcp into spare field */
     IoFLAGS(datasv) |= IOf_FAKE_DIRP;
     DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
-			  (void*)u.iop, SvPV_nolen(datasv)));
+			  IoANY(datasv), SvPV_nolen(datasv)));
     av_unshift(PL_rsfp_filters, 1);
     av_store(PL_rsfp_filters, 0, datasv) ;
     return(datasv);
@@ -2167,18 +2155,15 @@ void
 Perl_filter_del(pTHX_ filter_t funcp)
 {
     SV *datasv;
-    xpvio_filter_u u;
 
 #ifdef DEBUGGING
-    u.filter = funcp;
-    DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", (void*)u.iop));
+    DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", FPTR2DPTR(XPVIO *, funcp)));
 #endif
     if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
 	return;
     /* if filter is on top of stack (usual case) just pop it off */
     datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters));
-    u.iop = IoANY(datasv);
-    if (u.filter == funcp) {
+    if (IoANY(datasv) == FPTR2DPTR(void *, funcp)) {
 	IoFLAGS(datasv) &= ~IOf_FAKE_DIRP;
 	IoANY(datasv) = (void *)NULL;
 	sv_free(av_pop(PL_rsfp_filters));
@@ -2197,7 +2182,6 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
     filter_t funcp;
     SV *datasv = NULL;
-    xpvio_filter_u u;
 
     if (!PL_rsfp_filters)
 	return -1;
@@ -2239,11 +2223,10 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
 	return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
     }
     /* Get function pointer hidden within datasv	*/
-    u.iop = IoANY(datasv);
-    funcp = u.filter;
+    funcp = DPTR2FPTR(filter_t, IoANY(datasv));
     DEBUG_P(PerlIO_printf(Perl_debug_log,
 			  "filter_read %d: via function %p (%s)\n",
-			  idx, (void*)u.iop, SvPV_nolen(datasv)));
+			  idx, datasv, SvPV_nolen(datasv)));
     /* Call function. The function is expected to 	*/
     /* call "FILTER_READ(idx+1, buf_sv)" first.		*/
     /* Return: <0:error, =0:eof, >0:not eof 		*/