X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1a904fc88069e249a4bd0ef196a3f1a7f549e0fe..545872c5eddf1f00b9826a3d8d682387f1c5049d:/perl.h diff --git a/perl.h b/perl.h index d115ec3..87e7f0f 100644 --- a/perl.h +++ b/perl.h @@ -568,9 +568,9 @@ struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #else # define TAINT (PL_tainted = TRUE) # define TAINT_NOT (PL_tainted = FALSE) -# define TAINT_IF(c) if (c) { PL_tainted = TRUE; } -# define TAINT_ENV() if (PL_tainting) { taint_env(); } -# define TAINT_PROPER(s) if (PL_tainting) { taint_proper(NULL, s); } +# define TAINT_IF(c) if (UNLIKELY(c)) { PL_tainted = TRUE; } +# define TAINT_ENV() if (UNLIKELY(PL_tainting)) { taint_env(); } +# define TAINT_PROPER(s) if (UNLIKELY(PL_tainting)) { taint_proper(NULL, s); } # define TAINT_set(s) (PL_tainted = (s)) # define TAINT_get (PL_tainted) # define TAINTING_get (PL_tainting) @@ -743,15 +743,6 @@ EXTERN_C int syscall(int, ...); EXTERN_C int usleep(unsigned int); #endif -/* Funky places that do not have socket stuff. */ -#if defined(__LIBCATAMOUNT__) -# define MYSWAP -#endif - -#ifdef PERL_MICRO /* Last chance to export Perl_my_swap */ -# define MYSWAP -#endif - #ifdef PERL_CORE /* macros for correct constant construction */ @@ -804,189 +795,6 @@ EXTERN_C int usleep(unsigned int); (((U64)(x) & U64_CONST(0xff00000000000000)) >> 56) )) # endif -/*----------------------------------------------------------------------------*/ -# if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 /* little-endian */ -/*----------------------------------------------------------------------------*/ -# define my_htole16(x) (x) -# define my_letoh16(x) (x) -# define my_htole32(x) (x) -# define my_letoh32(x) (x) -# define my_htobe16(x) _swab_16_(x) -# define my_betoh16(x) _swab_16_(x) -# define my_htobe32(x) _swab_32_(x) -# define my_betoh32(x) _swab_32_(x) -# ifdef HAS_QUAD -# define my_htole64(x) (x) -# define my_letoh64(x) (x) -# define my_htobe64(x) _swab_64_(x) -# define my_betoh64(x) _swab_64_(x) -# endif -# define my_htoles(x) (x) -# define my_letohs(x) (x) -# define my_htolei(x) (x) -# define my_letohi(x) (x) -# define my_htolel(x) (x) -# define my_letohl(x) (x) -# if SHORTSIZE == 1 -# define my_htobes(x) (x) -# define my_betohs(x) (x) -# elif SHORTSIZE == 2 -# define my_htobes(x) _swab_16_(x) -# define my_betohs(x) _swab_16_(x) -# elif SHORTSIZE == 4 -# define my_htobes(x) _swab_32_(x) -# define my_betohs(x) _swab_32_(x) -# elif SHORTSIZE == 8 -# define my_htobes(x) _swab_64_(x) -# define my_betohs(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOBES -# define PERL_NEED_MY_BETOHS -# endif -# if INTSIZE == 1 -# define my_htobei(x) (x) -# define my_betohi(x) (x) -# elif INTSIZE == 2 -# define my_htobei(x) _swab_16_(x) -# define my_betohi(x) _swab_16_(x) -# elif INTSIZE == 4 -# define my_htobei(x) _swab_32_(x) -# define my_betohi(x) _swab_32_(x) -# elif INTSIZE == 8 -# define my_htobei(x) _swab_64_(x) -# define my_betohi(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOBEI -# define PERL_NEED_MY_BETOHI -# endif -# if LONGSIZE == 1 -# define my_htobel(x) (x) -# define my_betohl(x) (x) -# elif LONGSIZE == 2 -# define my_htobel(x) _swab_16_(x) -# define my_betohl(x) _swab_16_(x) -# elif LONGSIZE == 4 -# define my_htobel(x) _swab_32_(x) -# define my_betohl(x) _swab_32_(x) -# elif LONGSIZE == 8 -# define my_htobel(x) _swab_64_(x) -# define my_betohl(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOBEL -# define PERL_NEED_MY_BETOHL -# endif -# define my_htolen(p,n) NOOP -# define my_letohn(p,n) NOOP -# define my_htoben(p,n) my_swabn(p,n) -# define my_betohn(p,n) my_swabn(p,n) -/*----------------------------------------------------------------------------*/ -# elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 /* big-endian */ -/*----------------------------------------------------------------------------*/ -# define my_htobe16(x) (x) -# define my_betoh16(x) (x) -# define my_htobe32(x) (x) -# define my_betoh32(x) (x) -# define my_htole16(x) _swab_16_(x) -# define my_letoh16(x) _swab_16_(x) -# define my_htole32(x) _swab_32_(x) -# define my_letoh32(x) _swab_32_(x) -# ifdef HAS_QUAD -# define my_htobe64(x) (x) -# define my_betoh64(x) (x) -# define my_htole64(x) _swab_64_(x) -# define my_letoh64(x) _swab_64_(x) -# endif -# define my_htobes(x) (x) -# define my_betohs(x) (x) -# define my_htobei(x) (x) -# define my_betohi(x) (x) -# define my_htobel(x) (x) -# define my_betohl(x) (x) -# if SHORTSIZE == 1 -# define my_htoles(x) (x) -# define my_letohs(x) (x) -# elif SHORTSIZE == 2 -# define my_htoles(x) _swab_16_(x) -# define my_letohs(x) _swab_16_(x) -# elif SHORTSIZE == 4 -# define my_htoles(x) _swab_32_(x) -# define my_letohs(x) _swab_32_(x) -# elif SHORTSIZE == 8 -# define my_htoles(x) _swab_64_(x) -# define my_letohs(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOLES -# define PERL_NEED_MY_LETOHS -# endif -# if INTSIZE == 1 -# define my_htolei(x) (x) -# define my_letohi(x) (x) -# elif INTSIZE == 2 -# define my_htolei(x) _swab_16_(x) -# define my_letohi(x) _swab_16_(x) -# elif INTSIZE == 4 -# define my_htolei(x) _swab_32_(x) -# define my_letohi(x) _swab_32_(x) -# elif INTSIZE == 8 -# define my_htolei(x) _swab_64_(x) -# define my_letohi(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOLEI -# define PERL_NEED_MY_LETOHI -# endif -# if LONGSIZE == 1 -# define my_htolel(x) (x) -# define my_letohl(x) (x) -# elif LONGSIZE == 2 -# define my_htolel(x) _swab_16_(x) -# define my_letohl(x) _swab_16_(x) -# elif LONGSIZE == 4 -# define my_htolel(x) _swab_32_(x) -# define my_letohl(x) _swab_32_(x) -# elif LONGSIZE == 8 -# define my_htolel(x) _swab_64_(x) -# define my_letohl(x) _swab_64_(x) -# else -# define PERL_NEED_MY_HTOLEL -# define PERL_NEED_MY_LETOHL -# endif -# define my_htolen(p,n) my_swabn(p,n) -# define my_letohn(p,n) my_swabn(p,n) -# define my_htoben(p,n) NOOP -# define my_betohn(p,n) NOOP -/*----------------------------------------------------------------------------*/ -# else /* all other byte-orders */ -/*----------------------------------------------------------------------------*/ -# define PERL_NEED_MY_HTOLE16 -# define PERL_NEED_MY_LETOH16 -# define PERL_NEED_MY_HTOBE16 -# define PERL_NEED_MY_BETOH16 -# define PERL_NEED_MY_HTOLE32 -# define PERL_NEED_MY_LETOH32 -# define PERL_NEED_MY_HTOBE32 -# define PERL_NEED_MY_BETOH32 -# ifdef HAS_QUAD -# define PERL_NEED_MY_HTOLE64 -# define PERL_NEED_MY_LETOH64 -# define PERL_NEED_MY_HTOBE64 -# define PERL_NEED_MY_BETOH64 -# endif -# define PERL_NEED_MY_HTOLES -# define PERL_NEED_MY_LETOHS -# define PERL_NEED_MY_HTOBES -# define PERL_NEED_MY_BETOHS -# define PERL_NEED_MY_HTOLEI -# define PERL_NEED_MY_LETOHI -# define PERL_NEED_MY_HTOBEI -# define PERL_NEED_MY_BETOHI -# define PERL_NEED_MY_HTOLEL -# define PERL_NEED_MY_LETOHL -# define PERL_NEED_MY_HTOBEL -# define PERL_NEED_MY_BETOHL -/*----------------------------------------------------------------------------*/ -# endif /* end of byte-order macros */ -/*----------------------------------------------------------------------------*/ - /* The old value was hard coded at 1008. (4096-16) seems to be a bit faster, at least on FreeBSD. YMMV, so experiment. */ #ifndef PERL_ARENA_SIZE @@ -1641,15 +1449,15 @@ EXTERN_C char *crypt(const char *, const char *); # define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) #endif -/* BeOS 5.0 and Haiku R1 seem to define S_IREAD and S_IWRITE in +/* Haiku R1 seems to define S_IREAD and S_IWRITE in * which would get included through , but that is 3000 * lines in the future. --jhi */ -#if !defined(S_IREAD) && !(defined(__BEOS__) || defined(__HAIKU__)) +#if !defined(S_IREAD) && !defined(__HAIKU__) # define S_IREAD S_IRUSR #endif -#if !defined(S_IWRITE) && !(defined(__BEOS__) || defined(__HAIKU__)) +#if !defined(S_IWRITE) && !defined(__HAIKU__) # define S_IWRITE S_IWUSR #endif @@ -1709,7 +1517,7 @@ EXTERN_C char *crypt(const char *, const char *); #if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC) # ifdef PERL_USE_GCC_BRACE_GROUPS -# define my_vsnprintf(buffer, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak_nocontext("panic: vsnprintf buffer overflow"); __len__; }) +# define my_vsnprintf(buffer, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (Size_t)(len)) Perl_croak_nocontext("panic: vsnprintf buffer overflow"); __len__; }) # define PERL_MY_VSNPRINTF_GUARDED # else # define my_vsnprintf(buffer, len, ...) vsnprintf(buffer, len, __VA_ARGS__) @@ -2494,9 +2302,11 @@ typedef AV PAD; typedef AV PADNAMELIST; typedef SV PADNAME; -#if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW) -# define PERL_NEW_COPY_ON_WRITE -#endif +/* XXX for 5.18, disable the COW by default + * #if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW) + * # define PERL_NEW_COPY_ON_WRITE + * #endif + */ #if defined(PERL_OLD_COPY_ON_WRITE) || defined(PERL_NEW_COPY_ON_WRITE) # if defined(PERL_OLD_COPY_ON_WRITE) && defined(PERL_NEW_COPY_ON_WRITE) @@ -2504,6 +2314,8 @@ typedef SV PADNAME; # else # define PERL_ANY_COW # endif +#else +# define PERL_SAWAMPERSAND #endif #include "handy.h" @@ -2649,9 +2461,6 @@ typedef SV PADNAME; #if defined(__HAIKU__) # include "haiku/haikuish.h" # define ISHISH "haiku" -#elif defined(__BEOS__) -# include "beos/beosish.h" -# define ISHISH "beos" #endif #ifndef ISHISH @@ -3328,8 +3137,8 @@ typedef pthread_key_t perl_key; #else # define EXPECT(expr,val) (expr) #endif -#define LIKELY(cond) EXPECT(cond,1) -#define UNLIKELY(cond) EXPECT(cond,0) +#define LIKELY(cond) EXPECT(cBOOL(cond),TRUE) +#define UNLIKELY(cond) EXPECT(cBOOL(cond),FALSE) #ifdef HAS_BUILTIN_CHOOSE_EXPR /* placeholder */ #endif @@ -3536,36 +3345,70 @@ 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 -#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 +# 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) +# elif BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 + +/* Note that we can't straight out declare our own htonl and htons because + the Win32 build process forcibly undefines HAS_HTONL etc for its miniperl, + to avoid the overhead of initialising the socket subsystem, but the headers + that *declare* the various functions are still seen. If we declare our own + htonl etc they will clash with the declarations in the Win32 headers. */ + +PERL_STATIC_INLINE U32 +my_swap32(const U32 x) { + return ((x & 0xFF) << 24) | ((x >> 24) & 0xFF) + | ((x & 0x0000FF00) << 8) | ((x & 0x00FF0000) >> 8); +} + +PERL_STATIC_INLINE U16 +my_swap16(const U16 x) { + return ((x & 0xFF) << 8) | ((x >> 8) & 0xFF); +} + +# define htonl(x) my_swap32(x) +# define ntohl(x) my_swap32(x) +# define ntohs(x) my_swap16(x) +# define htons(x) my_swap16(x) +# else +# error "Unsupported byteorder" +/* The C pre-processor doesn't let us return the value of BYTEORDER as part of + the error message. Please check the value of the macro BYTEORDER, as defined + in config.h. The values of BYTEORDER we expect are + + big endian little endian + 32 bit 0x4321 0x1234 + 64 bit 0x87654321 0x12345678 + + If you have a system with a different byte order, please see + pod/perlhack.pod for how to submit a patch to add supporting code. +*/ +# endif #endif /* * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'. * -DWS */ -#if BYTEORDER != 0x1234 -# define HAS_VTOHL -# define HAS_VTOHS -# define HAS_HTOVL -# define HAS_HTOVS -# if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 +#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 +/* Little endian system, so vtohl, vtohs, htovl and htovs do not need to + re-order their values. However, to behave identically to the alternative + implementations, they should truncate to the correct size. */ +# define vtohl(x) ((x)&0xFFFFFFFF) +# define vtohs(x) ((x)&0xFFFF) +# define htovl(x) vtohl(x) +# define htovs(x) vtohs(x) +#elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321 # define vtohl(x) ((((x)&0xFF)<<24) \ +(((x)>>24)&0xFF) \ +(((x)&0x0000FF00)<<8) \ @@ -3573,14 +3416,11 @@ struct ptr_tbl { # define vtohs(x) ((((x)&0xFF)<<8) + (((x)>>8)&0xFF)) # define htovl(x) vtohl(x) # define htovs(x) vtohs(x) -# endif - /* otherwise default to functions in util.c */ -#ifndef htovs -short htovs(short n); -short vtohs(short n); -long htovl(long n); -long vtohl(long n); -#endif +#else +# error "Unsupported byteorder" +/* If you have need for current perl on PDP-11 or similar, and can help test + that blead keeps working on a mixed-endian system, then see + pod/perlhack.pod for how to submit patches to things working again. */ #endif /* *MAX Plus 1. A floating point value. @@ -4513,8 +4353,10 @@ EXTCONST unsigned char PL_mod_latin1_uc[] = { 248-32, 249-32, 250-32, 251-32, 252-32, 253-32, 254-32, 255 }; #else /* ! DOINIT */ +#ifndef EBCDIC EXTCONST unsigned char PL_fold[]; EXTCONST unsigned char PL_fold_latin1[]; +#endif EXTCONST unsigned char PL_mod_latin1_uc[]; EXTCONST unsigned char PL_latin1_lc[]; #endif @@ -4725,6 +4567,9 @@ EXTCONST char PL_bincompat_options[] = # ifdef PERL_POISON " PERL_POISON" # endif +# ifdef PERL_SAWAMPERSAND + " PERL_SAWAMPERSAND" +# endif # ifdef PERL_TRACK_MEMPOOL " PERL_TRACK_MEMPOOL" # endif @@ -5003,8 +4848,14 @@ struct interpreter { /* Set up PERLVAR macros for populating structs */ # define PERLVAR(prefix,var,type) type prefix##var; + +/* 'var' is an array of length 'n' */ # define PERLVARA(prefix,var,n,type) type prefix##var[n]; + +/* initialize 'var' to init' */ # define PERLVARI(prefix,var,type,init) type prefix##var; + +/* like PERLVARI, but make 'var' a const */ # define PERLVARIC(prefix,var,type,init) type prefix##var; struct interpreter { @@ -5021,8 +4872,8 @@ EXTCONST U16 PL_interp_size /* This will be useful for subsequent releases, because this has to be the same in your libperl as in main(), else you have a mismatch and must abort. */ -EXTCONST U16 PL_interp_size_5_16_0 - INIT(PERL_INTERPRETER_SIZE_UPTO_MEMBER(PERL_LAST_5_16_0_INTERP_MEMBER)); +EXTCONST U16 PL_interp_size_5_18_0 + INIT(PERL_INTERPRETER_SIZE_UPTO_MEMBER(PERL_LAST_5_18_0_INTERP_MEMBER)); # ifdef PERL_GLOBAL_STRUCT @@ -5227,8 +5078,21 @@ EXTCONST bool PL_valid_types_NV_set[]; #endif -/* Static inline funcs that depend on includes and declarations above */ -#include "inline.h" +#ifndef PERL_NO_INLINE_FUNCTIONS +/* Static inline funcs that depend on includes and declarations above. + Some of these reference functions in the perl object files, and some + compilers aren't smart enough to eliminate unused static inline + functions, so including this file in source code can cause link errors + even if the source code uses none of the functions. Hence including these + can be be suppressed by setting PERL_NO_INLINE_FUNCTIONS. Doing this will + (obviously) result in unworkable XS code, but allows simple probing code + to continue to work, because it permits tests to include the perl headers + for definitions without creating a link dependency on the perl library + (which may not exist yet). +*/ + +# include "inline.h" +#endif #include "overload.h" @@ -5663,10 +5527,9 @@ int flock(int fd, int op); #if O_TEXT != O_BINARY /* If you have different O_TEXT and O_BINARY and you are a CLRF shop, * that is, you are somehow DOSish. */ -# if defined(__BEOS__) || defined(__HAIKU__) || defined(__VOS__) || \ - defined(__CYGWIN__) - /* BeOS/Haiku has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect; - * BeOS/Haiku is always UNIXoid (LF), not DOSish (CRLF). */ +# if defined(__HAIKU__) || defined(__VOS__) || defined(__CYGWIN__) + /* Haiku has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect; + * Haiku is always UNIXoid (LF), not DOSish (CRLF). */ /* VOS has O_TEXT != O_BINARY, and they have effect, * but VOS always uses LF, never CRLF. */ /* If you have O_TEXT different from your O_BINARY but you still are