This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Provide ntohl, ntohs, htonl and htons no-op macros on big endian systems.
authorNicholas Clark <nick@ccl4.org>
Sat, 4 May 2013 20:03:59 +0000 (22:03 +0200)
committerNicholas Clark <nick@ccl4.org>
Mon, 20 May 2013 19:19:42 +0000 (21:19 +0200)
This means that there are always macros or functions for ntohl, ntohs,
htonl and htons available, so eliminate use of HAS_NTOHL etc, and
unconditionally compile the code that it was protecting. However, as code
on CPAN is using these guard macros, define all of them in perl.h

(Technically the 4 are not quite no-ops, as they truncate their values to
32 or 16 bits, to be consistent with the implementations for platforms which
need re-ordering.)

perl.h
pp_pack.c
pp_sys.c

diff --git a/perl.h b/perl.h
index df905d0..c1891db 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3537,24 +3537,25 @@ struct ptr_tbl {
 #define HAS_NTOHS
 #endif
 #ifndef HAS_HTONL
-#if (BYTEORDER & 0xffff) != 0x4321
 #define HAS_HTONS
 #define HAS_HTONL
 #define HAS_NTOHS
 #define HAS_NTOHL
+#  if (BYTEORDER & 0xffff) == 0x4321
+/* Big endian system, so ntohl, ntohs, htonl and htons do not need to
+   re-order their values. However, to behave identically to the alternative
+   implementations, they should truncate to the correct size.  */
+#    define ntohl(x)    ((x)&0xFFFFFFFF)
+#    define htonl(x)    ntohl(x)
+#    define ntohs(x)    ((x)&0xFFFF)
+#    define htons(x)    ntohs(x)
+#  else
 #define MYSWAP
 #define htons my_swap
 #define htonl my_htonl
 #define ntohs my_swap
 #define ntohl my_ntohl
 #endif
-#else
-#if (BYTEORDER & 0xffff) == 0x4321
-#undef HAS_HTONS
-#undef HAS_HTONL
-#undef HAS_NTOHS
-#undef HAS_NTOHL
-#endif
 #endif
 
 /*
index b47df9b..963f998 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -1476,10 +1476,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 #endif
                SHIFT16(utf8, s, strend, &au16, datumtype);
                DO_BO_UNPACK(au16, 16);
-#ifdef HAS_NTOHS
                if (datumtype == 'n')
                    au16 = PerlSock_ntohs(au16);
-#endif
                if (datumtype == 'v')
                    au16 = vtohs(au16);
                if (!checksum)
@@ -1498,10 +1496,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                ai16 = 0;
 # endif
                SHIFT16(utf8, s, strend, &ai16, datumtype);
-# ifdef HAS_NTOHS
                if (datumtype == ('n' | TYPE_IS_SHRIEKING))
                    ai16 = (I16) PerlSock_ntohs((U16) ai16);
-# endif /* HAS_NTOHS */
                if (datumtype == ('v' | TYPE_IS_SHRIEKING))
                    ai16 = (I16) vtohs((U16) ai16);
                if (!checksum)
@@ -1645,10 +1641,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 #endif
                SHIFT32(utf8, s, strend, &au32, datumtype);
                DO_BO_UNPACK(au32, 32);
-#ifdef HAS_NTOHL
                if (datumtype == 'N')
                    au32 = PerlSock_ntohl(au32);
-#endif
                if (datumtype == 'V')
                    au32 = vtohl(au32);
                if (!checksum)
@@ -1667,10 +1661,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                ai32 = 0;
 #endif
                SHIFT32(utf8, s, strend, &ai32, datumtype);
-#ifdef HAS_NTOHL
                if (datumtype == ('N' | TYPE_IS_SHRIEKING))
                    ai32 = (I32)PerlSock_ntohl((U32)ai32);
-#endif
                if (datumtype == ('V' | TYPE_IS_SHRIEKING))
                    ai32 = (I32)vtohl((U32)ai32);
                if (!checksum)
@@ -2863,9 +2855,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                I16 ai16;
                fromstr = NEXTFROM;
                ai16 = (I16)SvIV(fromstr);
-#ifdef HAS_HTONS
                ai16 = PerlSock_htons(ai16);
-#endif
                PUSH16(utf8, cur, &ai16);
            }
            break;
@@ -3070,9 +3060,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                U32 au32;
                fromstr = NEXTFROM;
                au32 = SvUV(fromstr);
-#ifdef HAS_HTONL
                au32 = PerlSock_htonl(au32);
-#endif
                PUSH32(utf8, cur, &au32);
            }
            break;
index 04ccddb..9458d2e 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4942,9 +4942,7 @@ PP(pp_gservent)
 #ifdef HAS_GETSERVBYPORT
        const char * const proto = POPpbytex;
        unsigned short port = (unsigned short)POPu;
-#ifdef HAS_HTONS
        port = PerlSock_htons(port);
-#endif
        sent = PerlSock_getservbyport(port, (proto && !*proto) ? NULL : proto);
 #else
        DIE(aTHX_ PL_no_sock_func, "getservbyport");
@@ -4962,11 +4960,7 @@ PP(pp_gservent)
        PUSHs(sv = sv_newmortal());
        if (sent) {
            if (which == OP_GSBYNAME) {
-#ifdef HAS_NTOHS
                sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port));
-#else
-               sv_setiv(sv, (IV)(sent->s_port));
-#endif
            }
            else
                sv_setpv(sv, sent->s_name);
@@ -4977,11 +4971,7 @@ PP(pp_gservent)
     if (sent) {
        mPUSHs(newSVpv(sent->s_name, 0));
        PUSHs(space_join_names_mortal(sent->s_aliases));
-#ifdef HAS_NTOHS
        mPUSHi(PerlSock_ntohs(sent->s_port));
-#else
-       mPUSHi(sent->s_port);
-#endif
        mPUSHs(newSVpv(sent->s_proto, 0));
     }