X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/12fbd33b4c244f0a97c39c9f6411b444814dbc56..dd3040134608b6ed899c2d38d321ae6d4da4c54a:/perl.h diff --git a/perl.h b/perl.h index 3aec746..c1d08bb 100644 --- a/perl.h +++ b/perl.h @@ -1,7 +1,7 @@ /* perl.h * * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -65,13 +65,45 @@ # endif #endif +#ifdef PERL_GLOBAL_STRUCT_PRIVATE +# ifndef PERL_GLOBAL_STRUCT +# define PERL_GLOBAL_STRUCT +# endif +#endif +#ifdef PERL_GLOBAL_STRUCT +# ifndef MULTIPLICITY +# define MULTIPLICITY +# endif +#endif + /* undef WIN32 when building on Cygwin (for libwin32) - gph */ #ifdef __CYGWIN__ # undef WIN32 # undef _WIN32 #endif -/* Use the reentrant APIs like localtime_r and getpwent_r */ +#if defined(__SYMBIAN32__) || (defined(__VC32__) && defined(WINS)) +# ifndef SYMBIAN +# define SYMBIAN +# endif +#endif + +#ifdef SYMBIAN +# include "symbian/symbian_proto.h" +#endif + +/* Any stack-challenged places. The limit varies (and often + * is configurable), but using more than a kilobyte of stack + * is usually dubious in these systems. */ +#if defined(EPOC) || defined(SYMBIAN) +/* EPOC/Symbian: need to work around the SDK features. * + * On WINS: MS VC5 generates calls to _chkstk, * + * if a "large" stack frame is allocated. * + * gcc on MARM does not generate calls like these. */ +# define USE_HEAP_INSTEAD_OF_STACK +#endif + +#/* Use the reentrant APIs like localtime_r and getpwent_r */ /* Win32 has naturally threadsafe libraries, no need to use any _r variants. */ #if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(PERL_DARWIN) # define USE_REENTRANT_API @@ -90,20 +122,55 @@ # endif #endif +#ifdef PERL_GLOBAL_STRUCT +# ifndef PERL_GET_VARS +# ifdef PERL_GLOBAL_STRUCT_PRIVATE + extern struct perl_vars* Perl_GetVarsPrivate(); +# define PERL_GET_VARS() Perl_GetVarsPrivate() /* see miniperlmain.c */ +# ifndef PERLIO_FUNCS_CONST +# define PERLIO_FUNCS_CONST /* Can't have these lying around. */ +# endif +# else +# define PERL_GET_VARS() PL_VarsPtr +# endif +# endif +#endif + +#define pVAR register struct perl_vars* my_vars PERL_UNUSED_DECL + +#ifdef PERL_GLOBAL_STRUCT +# define dVAR pVAR = (struct perl_vars*)PERL_GET_VARS() +#else +# define dVAR dNOOP +#endif + #ifdef PERL_IMPLICIT_CONTEXT # ifndef MULTIPLICITY # define MULTIPLICITY # endif # define pTHX register PerlInterpreter *my_perl PERL_UNUSED_DECL # define aTHX my_perl -# define dTHXa(a) pTHX = (PerlInterpreter*)a -# define dTHX pTHX = PERL_GET_THX +# ifdef PERL_GLOBAL_STRUCT +# define dTHXa(a) dVAR; pTHX = (PerlInterpreter*)a +# else +# define dTHXa(a) pTHX = (PerlInterpreter*)a +# endif +# ifdef PERL_GLOBAL_STRUCT +# define dTHX dVAR; pTHX = PERL_GET_THX +# else +# define dTHX pTHX = PERL_GET_THX +# endif # define pTHX_ pTHX, # define aTHX_ aTHX, -# define pTHX_1 2 +# define pTHX_1 2 # define pTHX_2 3 # define pTHX_3 4 # define pTHX_4 5 +# define pTHX_5 6 +# define pTHX_6 7 +# define pTHX_7 8 +# define pTHX_8 9 +# define pTHX_9 10 #endif #define STATIC static @@ -123,25 +190,37 @@ #define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string) #define CALLREGFREE CALL_FPTR(PL_regfree) -#ifdef PERL_FLEXIBLE_EXCEPTIONS -# define CALLPROTECT CALL_FPTR(PL_protect) -#endif - -#ifdef HASATTRIBUTE -# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) +#if defined(SYMBIAN) && defined(__GNUC__) +# ifdef __cplusplus # define PERL_UNUSED_DECL # else # define PERL_UNUSED_DECL __attribute__((unused)) # endif -#else -# define PERL_UNUSED_DECL #endif +#ifndef PERL_UNUSED_DECL +# ifdef HASATTRIBUTE_UNUSED +# define PERL_UNUSED_DECL __attribute__unused__ +# else +# define PERL_UNUSED_DECL +# endif +#endif + /* gcc -Wall: * for silencing unused variables that are actually used most of the time, - * but we cannot quite get rid of, such `ax' in PPCODE+noargs xsubs + * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs */ -#define PERL_UNUSED_VAR(var) if (0) var = var +#ifndef PERL_UNUSED_ARG +# ifdef lint +# include +# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) +# else +# define PERL_UNUSED_ARG(x) ((void)x) +# endif +#endif +#ifndef PERL_UNUSED_VAR +# define PERL_UNUSED_VAR(x) ((void)x) +#endif #define NOOP (void)0 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL @@ -157,6 +236,15 @@ # define pTHX_2 2 # define pTHX_3 3 # define pTHX_4 4 +# define pTHX_5 5 +# define pTHX_6 6 +# define pTHX_7 7 +# define pTHX_8 8 +# define pTHX_9 9 +#endif + +#ifndef dVAR +# define dVAR dNOOP #endif /* these are only defined for compatibility; should not be used internally */ @@ -181,9 +269,17 @@ * PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...). * dTHXs is therefore needed for all functions using PerlIO_foo(). */ #ifdef PERL_IMPLICIT_SYS -# define dTHXs dTHX +# ifdef PERL_GLOBAL_STRUCT_PRIVATE +# define dTHXs dVAR; dTHX +# else +# define dTHXs dTHX +# endif #else -# define dTHXs dNOOP +# ifdef PERL_GLOBAL_STRUCT_PRIVATE +# define dTHXs dVAR +# else +# define dTHXs dNOOP +# endif #endif #undef START_EXTERN_C @@ -199,6 +295,18 @@ # define EXTERN_C extern #endif +/* Some platforms require marking function declarations + * for them to be exportable. Used in perlio.h, proto.h + * is handled either by the makedef.pl or by defining the + * PERL_CALLCONV to be something special. See also the + * definition of XS() in XSUB.h. */ +#ifndef PERL_EXPORT_C +# define PERL_EXPORT_C extern +#endif +#ifndef PERL_XS_EXPORT_C +# define PERL_XS_EXPORT_C +#endif + #ifdef OP_IN_REGISTER # ifdef __GNUC__ # define stringify_immed(s) #s @@ -208,7 +316,9 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #endif #if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC) -# define PERL_GCC_BRACE_GROUPS_FORBIDDEN +# if !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +# define PERL_GCC_BRACE_GROUPS_FORBIDDEN +# endif #endif /* @@ -220,7 +330,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); */ #if !(defined(STMT_START) && defined(STMT_END)) # if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) -# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ +# define STMT_START (void)( /* gcc supports "({ STATEMENTS; })" */ # define STMT_END ) # else /* Now which other defined()s do we need here ??? */ @@ -275,7 +385,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); #define DOSISH 1 #endif -#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) || defined(NETWARE) +#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) || defined(NETWARE) || defined(SYMBIAN) # define STANDARD_C 1 #endif @@ -437,6 +547,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # include #endif +#ifdef SYMBIAN +# undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */ +#endif + #if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) && !defined(PERL_MICRO) int syscall(int, ...); #endif @@ -449,6 +563,253 @@ int usleep(unsigned int); # define MYSWAP #endif +#ifdef PERL_CORE + +/* macros for correct constant construction */ +# if INTSIZE >= 2 +# define U16_CONST(x) ((U16)x##U) +# else +# define U16_CONST(x) ((U16)x##UL) +# endif + +# if INTSIZE >= 4 +# define U32_CONST(x) ((U32)x##U) +# else +# define U32_CONST(x) ((U32)x##UL) +# endif + +# ifdef HAS_QUAD +# if INTSIZE >= 8 +# define U64_CONST(x) ((U64)x##U) +# elif LONGSIZE >= 8 +# define U64_CONST(x) ((U64)x##UL) +# elif QUADKIND == QUAD_IS_LONG_LONG +# define U64_CONST(x) ((U64)x##ULL) +# else /* best guess we can make */ +# define U64_CONST(x) ((U64)x##UL) +# endif +# endif + +/* byte-swapping functions for big-/little-endian conversion */ +# define _swab_16_(x) ((U16)( \ + (((U16)(x) & U16_CONST(0x00ff)) << 8) | \ + (((U16)(x) & U16_CONST(0xff00)) >> 8) )) + +# define _swab_32_(x) ((U32)( \ + (((U32)(x) & U32_CONST(0x000000ff)) << 24) | \ + (((U32)(x) & U32_CONST(0x0000ff00)) << 8) | \ + (((U32)(x) & U32_CONST(0x00ff0000)) >> 8) | \ + (((U32)(x) & U32_CONST(0xff000000)) >> 24) )) + +# ifdef HAS_QUAD +# define _swab_64_(x) ((U64)( \ + (((U64)(x) & U64_CONST(0x00000000000000ff)) << 56) | \ + (((U64)(x) & U64_CONST(0x000000000000ff00)) << 40) | \ + (((U64)(x) & U64_CONST(0x0000000000ff0000)) << 24) | \ + (((U64)(x) & U64_CONST(0x00000000ff000000)) << 8) | \ + (((U64)(x) & U64_CONST(0x000000ff00000000)) >> 8) | \ + (((U64)(x) & U64_CONST(0x0000ff0000000000)) >> 24) | \ + (((U64)(x) & U64_CONST(0x00ff000000000000)) >> 40) | \ + (((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 +#define PERL_ARENA_SIZE 4080 +#endif + +#endif /* PERL_CORE */ + +/* We no longer default to creating a new SV for GvSV. + Do this before embed. */ +#ifndef PERL_CREATE_GVSV +#define PERL_DONT_CREATE_GVSV +#endif + /* Cannot include embed.h here on Win32 as win32.h has not yet been included and defines some config variables e.g. HAVE_INTERP_INTERN */ @@ -458,6 +819,13 @@ int usleep(unsigned int); #define MEM_SIZE Size_t +/* Round all values passed to malloc up, by default to a multiple of + sizeof(size_t) +*/ +#ifndef PERL_STRLEN_ROUNDUP_QUANTUM +#define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size +#endif + #if defined(STANDARD_C) && defined(I_STDDEF) # include # define STRUCT_OFFSET(s,m) offsetof(s,m) @@ -465,10 +833,12 @@ int usleep(unsigned int); # define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) #endif -#if defined(I_STRING) || defined(__cplusplus) -# include -#else -# include +#ifndef SYMBIAN +# if defined(I_STRING) || defined(__cplusplus) +# include +# else +# include +# endif #endif /* This comes after so we don't try to change the standard @@ -516,7 +886,7 @@ int usleep(unsigned int); # define MALLOC_CHECK_TAINT(argc,argv,env) #endif /* MYMALLOC */ -#define TOO_LATE_FOR_(ch,s) Perl_croak(aTHX_ "Too late for \"-%c\" option%s", (char)(ch), s) +#define TOO_LATE_FOR_(ch,what) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), what) #define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "") #define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}") #define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL) @@ -762,7 +1132,8 @@ int sockatmark(int); #endif #define ERRSV GvSV(PL_errgv) -#define DEFSV GvSV(PL_defgv) +/* FIXME? Change the assignments to PL_defgv to instantiate GvSV? */ +#define DEFSV GvSVn(PL_defgv) #define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */ @@ -1091,6 +1462,13 @@ typedef UVTYPE UV; # endif #endif +#ifndef HAS_QUAD +# undef PERL_NEED_MY_HTOLE64 +# undef PERL_NEED_MY_LETOH64 +# undef PERL_NEED_MY_HTOBE64 +# undef PERL_NEED_MY_BETOH64 +#endif + #if defined(uts) || defined(UTS) # undef UV_MAX # define UV_MAX (4294967295u) @@ -1119,20 +1497,38 @@ typedef UVTYPE UV; #else # if PTRSIZE == LONGSIZE # define PTRV unsigned long +# define PTR2ul(p) (unsigned long)(p) # else # define PTRV unsigned # endif +#endif + +#ifndef INT2PTR # define INT2PTR(any,d) (any)(PTRV)(d) #endif + +#ifndef PTR2ul +# define PTR2ul(p) INT2PTR(unsigned long,p) +#endif + #define NUM2PTR(any,d) (any)(PTRV)(d) #define PTR2IV(p) INT2PTR(IV,p) #define PTR2UV(p) INT2PTR(UV,p) #define PTR2NV(p) NUM2PTR(NV,p) -#if PTRSIZE == LONGSIZE -# define PTR2ul(p) (unsigned long)(p) -#else -# define PTR2ul(p) INT2PTR(unsigned long,p) -#endif +#define PTR2nat(p) (PTRV)(p) /* pointer to integer of PTRSIZE */ + +/* 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)PTR2nat(p)) /* data pointer to function pointer */ +#define FPTR2DPTR(t,p) ((t)PTR2nat(p)) /* function pointer to data pointer */ #ifdef USE_LONG_DOUBLE # if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE @@ -1291,7 +1687,7 @@ typedef NVTYPE NV; /* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no prototype in */ # ifndef HAS_MODFL_PROTO -long double modfl(long double, long double *); +EXTERN_C long double modfl(long double, long double *); # endif # else # if defined(HAS_AINTL) && defined(HAS_COPYSIGNL) @@ -1747,7 +2143,6 @@ typedef struct context PERL_CONTEXT; typedef struct block BLOCK; typedef struct magic MAGIC; -typedef struct xrv XRV; typedef struct xpv XPV; typedef struct xpviv XPVIV; typedef struct xpvuv XPVUV; @@ -1767,7 +2162,6 @@ typedef struct ptr_tbl_ent PTR_TBL_ENT_t; typedef struct ptr_tbl PTR_TBL_t; typedef struct clone_params CLONE_PARAMS; - #include "handy.h" #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) @@ -1918,6 +2312,12 @@ typedef struct clone_params CLONE_PARAMS; # define ISHISH "epoc" #endif +#ifdef SYMBIAN +# include "symbian/symbianish.h" +# include "embed.h" +# define ISHISH "symbian" +#endif + #if defined(MACOS_TRADITIONAL) # include "macos/macish.h" # ifndef NO_ENVIRON_ARRAY @@ -1936,6 +2336,64 @@ typedef struct clone_params CLONE_PARAMS; # define ISHISH "unix" #endif +/* NSIG logic from Configure --> */ +/* Strange style to avoid deeply-nested #if/#else/#endif */ +#ifndef NSIG +# ifdef _NSIG +# define NSIG (_NSIG) +# endif +#endif + +#ifndef NSIG +# ifdef SIGMAX +# define NSIG (SIGMAX+1) +# endif +#endif + +#ifndef NSIG +# ifdef SIG_MAX +# define NSIG (SIG_MAX+1) +# endif +#endif + +#ifndef NSIG +# ifdef _SIG_MAX +# define NSIG (_SIG_MAX+1) +# endif +#endif + +#ifndef NSIG +# ifdef MAXSIG +# define NSIG (MAXSIG+1) +# endif +#endif + +#ifndef NSIG +# ifdef MAX_SIG +# define NSIG (MAX_SIG+1) +# endif +#endif + +#ifndef NSIG +# ifdef SIGARRAYSIZE +# define NSIG SIGARRAYSIZE /* Assume ary[SIGARRAYSIZE] */ +# endif +#endif + +#ifndef NSIG +# ifdef _sys_nsig +# define NSIG (_sys_nsig) /* Solaris 2.5 */ +# endif +#endif + +/* Default to some arbitrary number that's big enough to get most + of the common signals. +*/ +#ifndef NSIG +# define NSIG 50 +#endif +/* <-- NSIG logic from Configure */ + #ifndef NO_ENVIRON_ARRAY # define USE_ENVIRON_ARRAY #endif @@ -1951,7 +2409,7 @@ typedef struct clone_params CLONE_PARAMS; # define PERL_FPU_INIT fpsetmask(0); # else # if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO) -# define PERL_FPU_INIT PL_sigfpe_saved = signal(SIGFPE, SIG_IGN); +# define PERL_FPU_INIT PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN); # define PERL_FPU_PRE_EXEC { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe); # define PERL_FPU_POST_EXEC rsignal_restore(SIGFPE, &xfpe); } # else @@ -1998,6 +2456,41 @@ typedef struct clone_params CLONE_PARAMS; # endif #endif +/* In case Configure was not used (we are using a "canned config" + * such as Win32, or a cross-compilation setup, for example) try going + * by the gcc major and minor versions. One useful URL is + * http://www.ohse.de/uwe/articles/gcc-attributes.html, + * but contrary to this information warn_unused_result seems + * not to be in gcc 3.3.5, at least. --jhi + * Set these up now otherwise we get confused when some of the <*thread.h> + * includes below indirectly pull in (which needs to know if we + * have HASATTRIBUTE_FORMAT). + */ + +#if defined __GNUC__ +# if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */ +# define HASATTRIBUTE_FORMAT +# endif +# if __GNUC__ >= 3 /* 3.0 -> */ +# define HASATTRIBUTE_MALLOC +# endif +# if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */ +# define HASATTRIBUTE_NONNULL +# endif +# if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */ +# define HASATTRIBUTE_NORETURN +# endif +# if __GNUC__ >= 3 /* gcc 3.0 -> */ +# define HASATTRIBUTE_PURE +# endif +# if __GNUC__ >= 3 /* gcc 3.0 -> */ /* XXX Verify this version */ +# define HASATTRIBUTE_UNUSED +# endif +# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ +# define HASATTRIBUTE_WARN_UNUSED_RESULT +# endif +#endif + /* USE_5005THREADS needs to be after unixish.h as includes * which defines NSIG - which will stop inclusion of * this results in many functions being undeclared which bothers C++ @@ -2049,6 +2542,7 @@ typedef pthread_key_t perl_key; # include "netware.h" #endif +#define STATUS_UNIX PL_statusvalue #ifdef VMS # define STATUS_NATIVE PL_statusvalue_vms # define STATUS_NATIVE_EXPORT \ @@ -2065,13 +2559,12 @@ typedef pthread_key_t perl_key; else \ PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8; \ } STMT_END -# define STATUS_POSIX PL_statusvalue # ifdef VMSISH_STATUS -# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX) +# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX) # else -# define STATUS_CURRENT STATUS_POSIX +# define STATUS_CURRENT STATUS_UNIX # endif -# define STATUS_POSIX_SET(n) \ +# define STATUS_UNIX_SET(n) \ STMT_START { \ PL_statusvalue = (n); \ if (PL_statusvalue != -1) { \ @@ -2083,19 +2576,55 @@ typedef pthread_key_t perl_key; # define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1) # define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44) #else -# define STATUS_NATIVE STATUS_POSIX -# define STATUS_NATIVE_EXPORT STATUS_POSIX -# define STATUS_NATIVE_SET STATUS_POSIX_SET -# define STATUS_POSIX PL_statusvalue -# define STATUS_POSIX_SET(n) \ +# define STATUS_NATIVE PL_statusvalue_posix +# define STATUS_NATIVE_EXPORT STATUS_NATIVE +# if defined(WCOREDUMP) +# define STATUS_NATIVE_SET(n) \ + STMT_START { \ + PL_statusvalue_posix = (n); \ + if (PL_statusvalue_posix == -1) \ + PL_statusvalue = -1; \ + else { \ + PL_statusvalue = \ + (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \ + (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0) | \ + (WIFSIGNALED(PL_statusvalue_posix) && WCOREDUMP(PL_statusvalue_posix) ? 0x80 : 0); \ + } \ + } STMT_END +# elif defined(WIFEXITED) +# define STATUS_NATIVE_SET(n) \ + STMT_START { \ + PL_statusvalue_posix = (n); \ + if (PL_statusvalue_posix == -1) \ + PL_statusvalue = -1; \ + else { \ + PL_statusvalue = \ + (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \ + (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0); \ + } \ + } STMT_END +# else +# define STATUS_NATIVE_SET(n) \ + STMT_START { \ + PL_statusvalue_posix = (n); \ + if (PL_statusvalue_posix == -1) \ + PL_statusvalue = -1; \ + else { \ + PL_statusvalue = \ + PL_statusvalue_posix & 0xFFFF; \ + } \ + } STMT_END +# endif +# define STATUS_UNIX_SET(n) \ STMT_START { \ PL_statusvalue = (n); \ + PL_statusvalue_posix = PL_statusvalue; \ if (PL_statusvalue != -1) \ PL_statusvalue &= 0xFFFF; \ } STMT_END -# define STATUS_CURRENT STATUS_POSIX -# define STATUS_ALL_SUCCESS (PL_statusvalue = 0) -# define STATUS_ALL_FAILURE (PL_statusvalue = 1) +# define STATUS_CURRENT STATUS_UNIX +# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0) +# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1) #endif /* flags in PL_exit_flags for nature of exit() */ @@ -2149,53 +2678,107 @@ typedef pthread_key_t perl_key; # define PERL_SET_THX(t) PERL_SET_CONTEXT(t) #endif +/* + This replaces the previous %_ "hack" by the "%p" hacks. + All that is required is that the perl source does not + use "%-p" or "%-p" or "%p" formats. + These formats will still work in perl code. + See comments in sv.c for futher details. + + -DvdNUMBER= can be used to redefine VDf + + -DvdNUMBER=0 reverts VDf to "vd", as in perl5.8.7, + which works properly but gives compiler warnings + + Robin Barker 2005-07-14 +*/ + +#ifndef SVf_ +# define SVf_(n) "-" STRINGIFY(n) "p" +#endif + #ifndef SVf -# ifdef CHECK_FORMAT -# define SVf "p" -# ifndef SVf256 -# define SVf256 SVf -# endif -# else -# define SVf "_" -# endif +# define SVf "-p" #endif -#ifndef SVf256 -# define SVf256 ".256"SVf +#ifndef SVf32 +# define SVf32 SVf_(32) #endif -#ifndef UVf -# ifdef CHECK_FORMAT -# define UVf UVuf -# else -# define UVf "Vu" -# endif +#ifndef SVf256 +# define SVf256 SVf_(256) #endif +#ifndef vdNUMBER +# define vdNUMBER 1 +#endif + #ifndef VDf -# ifdef CHECK_FORMAT -# define VDf "p" +# if vdNUMBER +# define VDf STRINGIFY(vdNUMBER) "p" # else # define VDf "vd" # endif #endif + +#ifndef UVf +# define UVf UVuf +#endif -#ifndef Nullformat -# ifdef CHECK_FORMAT -# define Nullformat "%s","" -# else -# define Nullformat Nullch -# endif +#ifdef HASATTRIBUTE_FORMAT +# define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) +#endif +#ifdef HASATTRIBUTE_MALLOC +# define __attribute__malloc__ __attribute__((__malloc__)) +#endif +#ifdef HASATTRIBUTE_NONNULL +# define __attribute__nonnull__(a) __attribute__((nonnull(a))) +#endif +#ifdef HASATTRIBUTE_NORETURN +# define __attribute__noreturn__ __attribute__((noreturn)) +#endif +#ifdef HASATTRIBUTE_PURE +# define __attribute__pure__ __attribute__((pure)) +#endif +#ifdef HASATTRIBUTE_UNUSED +# define __attribute__unused__ __attribute__((unused)) +#endif +#ifdef HASATTRIBUTE_WARN_UNUSED_RESULT +# define __attribute__warn_unused_result__ __attribute__((warn_unused_result)) #endif +/* If we haven't defined the attributes yet, define them to blank. */ #ifndef __attribute__format__ -# ifdef CHECK_FORMAT -# define __attribute__format__(x,y,z) __attribute__((__format__(x,y,z))) -# else -# define __attribute__format__(x,y,z) -# endif +# define __attribute__format__(x,y,z) #endif - +#ifndef __attribute__malloc__ +# define __attribute__malloc__ +#endif +#ifndef __attribute__nonnull__ +# define __attribute__nonnull__(a) +#endif +#ifndef __attribute__noreturn__ +# define __attribute__noreturn__ +#endif +#ifndef __attribute__pure__ +# define __attribute__pure__ +#endif +#ifndef __attribute__unused__ +# define __attribute__unused__ +#endif +#ifndef __attribute__warn_unused_result__ +# define __attribute__warn_unused_result__ +#endif + +/* For functions that are marked as __attribute__noreturn__, it's not + appropriate to call return. In either case, include the lint directive. + */ +#ifdef HASATTRIBUTE_NORETURN +# define NORETURN_FUNCTION_END /* NOT REACHED */ +#else +# define NORETURN_FUNCTION_END /* NOT REACHED */ return 0 +#endif + /* Some unistd.h's give a prototype for pause() even though HAS_PAUSE ends up undefined. This causes the #define below to be rejected by the compiler. Sigh. @@ -2330,9 +2913,12 @@ struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */ typedef I32 CHECKPOINT; +/* Keep next first in this structure, because sv_free_arenas take + advantage of this to share code between the pte arenas and the SV + body arenas */ struct ptr_tbl_ent { struct ptr_tbl_ent* next; - void* oldval; + const void* oldval; void* newval; }; @@ -2467,7 +3053,7 @@ long vtohl(long n); #endif #ifndef __cplusplus -#ifndef UNDER_CE +#if !(defined(UNDER_CE) || defined(SYMBIAN)) Uid_t getuid (void); Uid_t geteuid (void); Gid_t getgid (void); @@ -2721,25 +3307,19 @@ Gid_t getegid (void); #define PERL_MAGIC_arylen '#' /* Array length ($#ary) */ #define PERL_MAGIC_pos '.' /* pos() lvalue */ #define PERL_MAGIC_backref '<' /* for weak ref data */ +#define PERL_MAGIC_symtab ':' /* extra data for symbol tables */ +#define PERL_MAGIC_rhash '%' /* extra data for restricted hashes */ +#define PERL_MAGIC_arylen_p '@' /* to move arylen out of XPVAV */ #define PERL_MAGIC_ext '~' /* Available for use by extensions */ #ifndef assert /* might have been included somehow */ -#ifdef DEBUGGING -#define assert(what) PERL_DEB( { \ - if (!(what)) { \ - Perl_croak(aTHX_ "Assertion " STRINGIFY(what) " failed: file \"%s\", line %d", \ - __FILE__, __LINE__); \ - PerlProc_exit(1); \ - }}) -#else -#define assert(what) PERL_DEB( { \ - if (!(what)) { \ - Perl_croak(aTHX_ "Assertion failed: file \"%s\", line %d", \ - __FILE__, __LINE__); \ - PerlProc_exit(1); \ - }}) -#endif +#define assert(what) PERL_DEB( \ + ((what) ? ((void) 0) : \ + (Perl_croak(aTHX_ "Assertion %s failed: file \"" __FILE__ \ + "\", line %d", STRINGIFY(what), __LINE__), \ + PerlProc_exit(1), \ + (void) 0))) #endif struct ufuncs { @@ -2996,7 +3576,7 @@ START_EXTERN_C /* handy constants */ EXTCONST char PL_warn_uninit[] - INIT("Use of uninitialized value%s%s"); + INIT("Use of uninitialized value%s%s%s"); EXTCONST char PL_warn_nosemi[] INIT("Semicolon seems to be missing"); EXTCONST char PL_warn_reserved[] @@ -3007,12 +3587,14 @@ EXTCONST char PL_no_wrongref[] INIT("Can't use %s ref as %s ref"); EXTCONST char PL_no_symref[] INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"); +EXTCONST char PL_no_symref_sv[] + INIT("Can't use string (\"%" SVf32 "\") as %s ref while \"strict refs\" in use"); EXTCONST char PL_no_usym[] INIT("Can't use an undefined value as %s reference"); EXTCONST char PL_no_aelem[] INIT("Modification of non-creatable array value attempted, subscript %d"); -EXTCONST char PL_no_helem[] - INIT("Modification of non-creatable hash value attempted, subscript \"%s\""); +EXTCONST char PL_no_helem_sv[] + INIT("Modification of non-creatable hash value attempted, subscript \""SVf"\""); EXTCONST char PL_no_modify[] INIT("Modification of a read-only value attempted"); EXTCONST char PL_no_mem[] @@ -3029,24 +3611,28 @@ EXTCONST char PL_no_myglob[] INIT("\"my\" variable %s can't be in a package"); EXTCONST char PL_no_localize_ref[] INIT("Can't localize through a reference"); +#ifdef PERL_MALLOC_WRAP +EXTCONST char PL_memory_wrap[] + INIT("panic: memory wrap"); +#endif EXTCONST char PL_uuemap[65] INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"); #ifdef DOINIT -EXT char *PL_sig_name[] = { SIG_NAME }; -EXT int PL_sig_num[] = { SIG_NUM }; +EXTCONST char* const PL_sig_name[] = { SIG_NAME }; +EXTCONST int PL_sig_num[] = { SIG_NUM }; #else -EXT char *PL_sig_name[]; -EXT int PL_sig_num[]; +EXTCONST char* const PL_sig_name[]; +EXTCONST int PL_sig_num[]; #endif /* fast conversion and case folding tables */ #ifdef DOINIT #ifdef EBCDIC -EXT unsigned char PL_fold[] = { /* fast EBCDIC case folding table */ +EXTCONST unsigned char PL_fold[] = { /* fast EBCDIC case folding table */ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, @@ -3120,8 +3706,9 @@ EXTCONST unsigned char PL_fold[] = { EXTCONST unsigned char PL_fold[]; #endif +#ifndef PERL_GLOBAL_STRUCT /* or perlvars.h */ #ifdef DOINIT -EXT unsigned char PL_fold_locale[] = { +EXT unsigned char PL_fold_locale[] = { /* Unfortunately not EXTCONST. */ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, @@ -3156,12 +3743,13 @@ EXT unsigned char PL_fold_locale[] = { 248, 249, 250, 251, 252, 253, 254, 255 }; #else -EXT unsigned char PL_fold_locale[]; +EXT unsigned char PL_fold_locale[]; /* Unfortunately not EXTCONST. */ #endif +#endif /* !PERL_GLOBAL_STRUCT */ #ifdef DOINIT #ifdef EBCDIC -EXT unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */ +EXTCONST unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */ 1, 2, 84, 151, 154, 155, 156, 157, 165, 246, 250, 3, 158, 7, 18, 29, 40, 51, 62, 73, 85, 96, 107, 118, @@ -3237,7 +3825,7 @@ EXTCONST unsigned char PL_freq[]; #ifdef DEBUGGING #ifdef DOINIT -EXTCONST char* PL_block_type[] = { +EXTCONST char* const PL_block_type[] = { "NULL", "SUB", "EVAL", @@ -3321,7 +3909,9 @@ enum { /* pass one of these to get_vtbl */ want_vtbl_regdata, want_vtbl_regdatum, want_vtbl_backref, - want_vtbl_utf8 + want_vtbl_utf8, + want_vtbl_symtab, + want_vtbl_arylen_p }; /* Note: the lowest 8 bits are reserved for @@ -3378,7 +3968,9 @@ struct perl_debug_pad { }; #define PERL_DEBUG_PAD(i) &(PL_debug_pad.pad[i]) -#define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, SvCUR(PERL_DEBUG_PAD(i)) = 0, PERL_DEBUG_PAD(i)) +#define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, \ + (((XPV*) SvANY(PERL_DEBUG_PAD(i)))->xpv_cur = 0), \ + PERL_DEBUG_PAD(i)) /* Enable variables which are pointers to functions */ typedef void (CPERLscope(*peep_t))(pTHX_ OP* o); @@ -3406,6 +3998,10 @@ typedef void (*XSUBADDR_t) (pTHX_ CV *); #define PERLVARA(var,n,type) type var[n]; #define PERLVARI(var,type,init) type var; #define PERLVARIC(var,type,init) type var; +#define PERLVARISC(var,init) const char var[sizeof(init)]; + +typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX); +typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); /* Interpreter exitlist entry */ typedef struct exitlistentry { @@ -3413,14 +4009,28 @@ typedef struct exitlistentry { void *ptr; } PerlExitListEntry; +/* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */ +/* These have to be before perlvars.h */ +#if !defined(HAS_SIGACTION) && defined(VMS) +# define FAKE_PERSISTENT_SIGNAL_HANDLERS +#endif +/* if we're doing kill() with sys$sigprc on VMS, FAKE_DEFAULT_SIGNAL_HANDLERS */ +#if defined(KILL_BY_SIGPRC) +# define FAKE_DEFAULT_SIGNAL_HANDLERS +#endif + #ifdef PERL_GLOBAL_STRUCT struct perl_vars { # include "perlvars.h" }; # ifdef PERL_CORE +# ifndef PERL_GLOBAL_STRUCT_PRIVATE EXT struct perl_vars PL_Vars; EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars); +# undef PERL_GET_VARS +# define PERL_GET_VARS() PL_VarsPtr +# endif /* !PERL_GLOBAL_STRUCT_PRIVATE */ # else /* PERL_CORE */ # if !defined(__GNUC__) || !defined(WIN32) EXT @@ -3461,25 +4071,9 @@ typedef void *Thread; #undef PERLVARA #undef PERLVARI #undef PERLVARIC +#undef PERLVARISC -/* Types used by pack/unpack */ -typedef enum { - e_no_len, /* no length */ - e_number, /* number, [] */ - e_star /* asterisk */ -} howlen_t; - -typedef struct { - char* patptr; /* current template char */ - char* patend; /* one after last char */ - char* grpbeg; /* 1st char of ()-group */ - char* grpend; /* end of ()-group */ - I32 code; /* template code (!) */ - I32 length; /* length/repeat count */ - howlen_t howlen; /* how length is given */ - int level; /* () nesting level */ - U32 flags; /* /=4, comma=2, pack=1 */ -} tempsym_t; +struct tempsym; /* defined in pp_pack.c */ #include "thread.h" #include "pp.h" @@ -3487,20 +4081,10 @@ typedef struct { #ifndef PERL_CALLCONV # define PERL_CALLCONV #endif - -#ifndef NEXT30_NO_ATTRIBUTE -# ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ -# ifdef __attribute__ /* Avoid possible redefinition errors */ -# undef __attribute__ -# endif -# define __attribute__(attr) -# endif -#endif - #undef PERL_CKDEF #undef PERL_PPDEF -#define PERL_CKDEF(s) OP *s (pTHX_ OP *o); -#define PERL_PPDEF(s) OP *s (pTHX); +#define PERL_CKDEF(s) PERL_CALLCONV OP *s (pTHX_ OP *o); +#define PERL_PPDEF(s) PERL_CALLCONV OP *s (pTHX); #include "proto.h" @@ -3522,6 +4106,7 @@ typedef struct { #define PERLVARA(var,n,type) EXT type PL_##var[n]; #define PERLVARI(var,type,init) EXT type PL_##var INIT(init); #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init); +#define PERLVARISC(var,init) EXTCONST char PL_##var[sizeof(init)] INIT(init); #if !defined(MULTIPLICITY) START_EXTERN_C @@ -3551,142 +4136,374 @@ END_EXTERN_C START_EXTERN_C #ifdef DOINIT - -EXT MGVTBL PL_vtbl_sv = {MEMBER_TO_FPTR(Perl_magic_get), - MEMBER_TO_FPTR(Perl_magic_set), - MEMBER_TO_FPTR(Perl_magic_len), - 0, 0}; -EXT MGVTBL PL_vtbl_env = {0, MEMBER_TO_FPTR(Perl_magic_set_all_env), - 0, MEMBER_TO_FPTR(Perl_magic_clear_all_env), - 0}; -EXT MGVTBL PL_vtbl_envelem = {0, MEMBER_TO_FPTR(Perl_magic_setenv), - 0, MEMBER_TO_FPTR(Perl_magic_clearenv), - 0}; -EXT MGVTBL PL_vtbl_sig = {0, 0, 0, 0, 0}; -#ifdef PERL_MICRO -EXT MGVTBL PL_vtbl_sigelem = {0, 0, 0, 0, 0}; +# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {a,b,c,d,e,f,g} +# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g} /* Like MGVTBL_SET but with the get magic having a const MG* */ #else -EXT MGVTBL PL_vtbl_sigelem = {MEMBER_TO_FPTR(Perl_magic_getsig), - MEMBER_TO_FPTR(Perl_magic_setsig), - 0, MEMBER_TO_FPTR(Perl_magic_clearsig), - 0}; -#endif -EXT MGVTBL PL_vtbl_pack = {0, 0, - MEMBER_TO_FPTR(Perl_magic_sizepack), - MEMBER_TO_FPTR(Perl_magic_wipepack), - 0}; -EXT MGVTBL PL_vtbl_packelem = {MEMBER_TO_FPTR(Perl_magic_getpack), - MEMBER_TO_FPTR(Perl_magic_setpack), - 0, MEMBER_TO_FPTR(Perl_magic_clearpack), - 0}; -EXT MGVTBL PL_vtbl_dbline = {0, MEMBER_TO_FPTR(Perl_magic_setdbline), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_isa = {0, MEMBER_TO_FPTR(Perl_magic_setisa), - 0, MEMBER_TO_FPTR(Perl_magic_setisa), - 0}; -EXT MGVTBL PL_vtbl_isaelem = {0, MEMBER_TO_FPTR(Perl_magic_setisa), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_arylen = {MEMBER_TO_FPTR(Perl_magic_getarylen), - MEMBER_TO_FPTR(Perl_magic_setarylen), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_glob = {MEMBER_TO_FPTR(Perl_magic_getglob), - MEMBER_TO_FPTR(Perl_magic_setglob), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_mglob = {0, MEMBER_TO_FPTR(Perl_magic_setmglob), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_nkeys = {MEMBER_TO_FPTR(Perl_magic_getnkeys), - MEMBER_TO_FPTR(Perl_magic_setnkeys), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_taint = {MEMBER_TO_FPTR(Perl_magic_gettaint), - MEMBER_TO_FPTR(Perl_magic_settaint), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_substr = {MEMBER_TO_FPTR(Perl_magic_getsubstr), - MEMBER_TO_FPTR(Perl_magic_setsubstr), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_vec = {MEMBER_TO_FPTR(Perl_magic_getvec), - MEMBER_TO_FPTR(Perl_magic_setvec), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_pos = {MEMBER_TO_FPTR(Perl_magic_getpos), - MEMBER_TO_FPTR(Perl_magic_setpos), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_bm = {0, MEMBER_TO_FPTR(Perl_magic_setbm), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_fm = {0, MEMBER_TO_FPTR(Perl_magic_setfm), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_uvar = {MEMBER_TO_FPTR(Perl_magic_getuvar), - MEMBER_TO_FPTR(Perl_magic_setuvar), - 0, 0, 0}; -EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem), - MEMBER_TO_FPTR(Perl_magic_setdefelem), - 0, 0, 0}; - -EXT MGVTBL PL_vtbl_regexp = {0, MEMBER_TO_FPTR(Perl_magic_setregexp),0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)}; -EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0}; -EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get), - MEMBER_TO_FPTR(Perl_magic_regdatum_set), 0, 0, 0}; +# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var +# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var +#endif + +MGVTBL_SET( + PL_vtbl_sv, + MEMBER_TO_FPTR(Perl_magic_get), + MEMBER_TO_FPTR(Perl_magic_set), + MEMBER_TO_FPTR(Perl_magic_len), + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_env, + NULL, + MEMBER_TO_FPTR(Perl_magic_set_all_env), + NULL, + MEMBER_TO_FPTR(Perl_magic_clear_all_env), + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_envelem, + NULL, + MEMBER_TO_FPTR(Perl_magic_setenv), + NULL, + MEMBER_TO_FPTR(Perl_magic_clearenv), + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_sig, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL +); -#ifdef USE_LOCALE_COLLATE -EXT MGVTBL PL_vtbl_collxfrm = {0, - MEMBER_TO_FPTR(Perl_magic_setcollxfrm), - 0, 0, 0}; -#endif - -EXT MGVTBL PL_vtbl_amagic = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), - 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; -EXT MGVTBL PL_vtbl_amagicelem = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), - 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; - -EXT MGVTBL PL_vtbl_backref = {0, 0, - 0, 0, MEMBER_TO_FPTR(Perl_magic_killbackrefs)}; - -EXT MGVTBL PL_vtbl_ovrld = {0, 0, - 0, 0, MEMBER_TO_FPTR(Perl_magic_freeovrld)}; - -EXT MGVTBL PL_vtbl_utf8 = {0, - MEMBER_TO_FPTR(Perl_magic_setutf8), - 0, 0, 0}; - -#else /* !DOINIT */ - -EXT MGVTBL PL_vtbl_sv; -EXT MGVTBL PL_vtbl_env; -EXT MGVTBL PL_vtbl_envelem; -EXT MGVTBL PL_vtbl_sig; -EXT MGVTBL PL_vtbl_sigelem; -EXT MGVTBL PL_vtbl_pack; -EXT MGVTBL PL_vtbl_packelem; -EXT MGVTBL PL_vtbl_dbline; -EXT MGVTBL PL_vtbl_isa; -EXT MGVTBL PL_vtbl_isaelem; -EXT MGVTBL PL_vtbl_arylen; -EXT MGVTBL PL_vtbl_glob; -EXT MGVTBL PL_vtbl_mglob; -EXT MGVTBL PL_vtbl_nkeys; -EXT MGVTBL PL_vtbl_taint; -EXT MGVTBL PL_vtbl_substr; -EXT MGVTBL PL_vtbl_vec; -EXT MGVTBL PL_vtbl_pos; -EXT MGVTBL PL_vtbl_bm; -EXT MGVTBL PL_vtbl_fm; -EXT MGVTBL PL_vtbl_uvar; -EXT MGVTBL PL_vtbl_ovrld; - -EXT MGVTBL PL_vtbl_defelem; -EXT MGVTBL PL_vtbl_regexp; -EXT MGVTBL PL_vtbl_regdata; -EXT MGVTBL PL_vtbl_regdatum; +#ifdef PERL_MICRO +MGVTBL_SET( + PL_vtbl_sigelem, + NULL, NULL, NULL, NULL, NULL, NULL, NULL +); +#else +MGVTBL_SET( + PL_vtbl_sigelem, + MEMBER_TO_FPTR(Perl_magic_getsig), + MEMBER_TO_FPTR(Perl_magic_setsig), + NULL, + MEMBER_TO_FPTR(Perl_magic_clearsig), + NULL, + NULL, + NULL +); +#endif + +MGVTBL_SET( + PL_vtbl_pack, + NULL, + NULL, + MEMBER_TO_FPTR(Perl_magic_sizepack), + MEMBER_TO_FPTR(Perl_magic_wipepack), + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_packelem, + MEMBER_TO_FPTR(Perl_magic_getpack), + MEMBER_TO_FPTR(Perl_magic_setpack), + NULL, + MEMBER_TO_FPTR(Perl_magic_clearpack), + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_dbline, + NULL, + MEMBER_TO_FPTR(Perl_magic_setdbline), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_isa, + NULL, + MEMBER_TO_FPTR(Perl_magic_setisa), + NULL, + MEMBER_TO_FPTR(Perl_magic_setisa), + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_isaelem, + NULL, + MEMBER_TO_FPTR(Perl_magic_setisa), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET_CONST_MAGIC_GET( + PL_vtbl_arylen, + MEMBER_TO_FPTR(Perl_magic_getarylen), + MEMBER_TO_FPTR(Perl_magic_setarylen), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_arylen_p, + NULL, + NULL, + NULL, + NULL, + MEMBER_TO_FPTR(Perl_magic_freearylen_p), + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_glob, + MEMBER_TO_FPTR(Perl_magic_getglob), + MEMBER_TO_FPTR(Perl_magic_setglob), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_mglob, + NULL, + MEMBER_TO_FPTR(Perl_magic_setmglob), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_nkeys, + MEMBER_TO_FPTR(Perl_magic_getnkeys), + MEMBER_TO_FPTR(Perl_magic_setnkeys), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_taint, + MEMBER_TO_FPTR(Perl_magic_gettaint), + MEMBER_TO_FPTR(Perl_magic_settaint), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_substr, + MEMBER_TO_FPTR(Perl_magic_getsubstr), + MEMBER_TO_FPTR(Perl_magic_setsubstr), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_vec, + MEMBER_TO_FPTR(Perl_magic_getvec), + MEMBER_TO_FPTR(Perl_magic_setvec), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_pos, + MEMBER_TO_FPTR(Perl_magic_getpos), + MEMBER_TO_FPTR(Perl_magic_setpos), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_bm, + NULL, + MEMBER_TO_FPTR(Perl_magic_setbm), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_fm, + NULL, + MEMBER_TO_FPTR(Perl_magic_setfm), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_uvar, + MEMBER_TO_FPTR(Perl_magic_getuvar), + MEMBER_TO_FPTR(Perl_magic_setuvar), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_defelem, + MEMBER_TO_FPTR(Perl_magic_getdefelem), + MEMBER_TO_FPTR(Perl_magic_setdefelem), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_regexp, + NULL, + MEMBER_TO_FPTR(Perl_magic_setregexp), + NULL, + NULL, + MEMBER_TO_FPTR(Perl_magic_freeregexp), + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_regdata, + NULL, + NULL, + MEMBER_TO_FPTR(Perl_magic_regdata_cnt), + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_regdatum, + MEMBER_TO_FPTR(Perl_magic_regdatum_get), + MEMBER_TO_FPTR(Perl_magic_regdatum_set), + NULL, + NULL, + NULL, + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_amagic, + NULL, + MEMBER_TO_FPTR(Perl_magic_setamagic), + NULL, + NULL, + MEMBER_TO_FPTR(Perl_magic_setamagic), + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_amagicelem, + NULL, + MEMBER_TO_FPTR(Perl_magic_setamagic), + NULL, + NULL, + MEMBER_TO_FPTR(Perl_magic_setamagic), + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_backref, + NULL, + NULL, + NULL, + NULL, + MEMBER_TO_FPTR(Perl_magic_killbackrefs), + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_ovrld, + NULL, + NULL, + NULL, + NULL, + MEMBER_TO_FPTR(Perl_magic_freeovrld), + NULL, + NULL +); + +MGVTBL_SET( + PL_vtbl_utf8, + NULL, + MEMBER_TO_FPTR(Perl_magic_setutf8), + NULL, + NULL, + NULL, + NULL, + NULL +); #ifdef USE_LOCALE_COLLATE -EXT MGVTBL PL_vtbl_collxfrm; +MGVTBL_SET( + PL_vtbl_collxfrm, + NULL, + MEMBER_TO_FPTR(Perl_magic_setcollxfrm), + NULL, + NULL, + NULL, + NULL, + NULL +); #endif -EXT MGVTBL PL_vtbl_amagic; -EXT MGVTBL PL_vtbl_amagicelem; - -EXT MGVTBL PL_vtbl_backref; -EXT MGVTBL PL_vtbl_utf8; - -#endif /* !DOINIT */ enum { fallback_amg, abs_amg, @@ -3727,10 +4544,10 @@ enum { }; #define NofAMmeth max_amg_code -#define AMG_id2name(id) ((char*)PL_AMG_names[id]+1) +#define AMG_id2name(id) (PL_AMG_names[id]+1) #ifdef DOINIT -EXTCONST char * PL_AMG_names[NofAMmeth] = { +EXTCONST char * const PL_AMG_names[NofAMmeth] = { /* Names kept in the symbol table. fallback => "()", the rest has "(" prepended. The only other place in perl which knows about this convention is AMG_id2name (used for debugging output and @@ -4025,26 +4842,6 @@ typedef struct am_table_short AMTS; #define PERL_ALLOC_CHECK(p) NOOP #endif -/* - * nice_chunk and nice_chunk size need to be set - * and queried under the protection of sv_mutex - */ -#define offer_nice_chunk(chunk, chunk_size) STMT_START { \ - void *new_chunk; \ - U32 new_chunk_size; \ - LOCK_SV_MUTEX; \ - new_chunk = (void *)(chunk); \ - new_chunk_size = (chunk_size); \ - if (new_chunk_size > PL_nice_chunk_size) { \ - if (PL_nice_chunk) Safefree(PL_nice_chunk); \ - PL_nice_chunk = new_chunk; \ - PL_nice_chunk_size = new_chunk_size; \ - } else { \ - Safefree(chunk); \ - } \ - UNLOCK_SV_MUTEX; \ - } STMT_END - #ifdef HAS_SEM # include # include @@ -4125,6 +4922,13 @@ typedef struct am_table_short AMTS; Zero(my_cxtp, 1, my_cxt_t); \ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) +/* Clones the per-interpreter data. */ +#define MY_CXT_CLONE \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ + Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ #define MY_CXT (*my_cxtp) @@ -4144,6 +4948,7 @@ typedef struct am_table_short AMTS; #define dMY_CXT_SV dNOOP #define dMY_CXT dNOOP #define MY_CXT_INIT NOOP +#define MY_CXT_CLONE NOOP #define MY_CXT my_cxt #define pMY_CXT void @@ -4247,6 +5052,19 @@ int flock(int fd, int op); # define PERL_MOUNT_NOSUID M_NOSUID #endif +#if !defined(PERL_MOUNT_NOEXEC) && defined(MOUNT_NOEXEC) +# define PERL_MOUNT_NOEXEC MOUNT_NOEXEC +#endif +#if !defined(PERL_MOUNT_NOEXEC) && defined(MNT_NOEXEC) +# define PERL_MOUNT_NOEXEC MNT_NOEXEC +#endif +#if !defined(PERL_MOUNT_NOEXEC) && defined(MS_NOEXEC) +# define PERL_MOUNT_NOEXEC MS_NOEXEC +#endif +#if !defined(PERL_MOUNT_NOEXEC) && defined(M_NOEXEC) +# define PERL_MOUNT_NOEXEC M_NOEXEC +#endif + #endif /* IAMSUID */ #ifdef I_LIBUTIL @@ -4393,6 +5211,10 @@ extern void moncontrol(int); * but also beware since this evaluates its argument twice, so no x++. */ #define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) +#if defined(__DECC) && defined(__osf__) +#pragma message disable (mainparm) /* Perl uses the envp in main(). */ +#endif + /* and finally... */ #define PERL_PATCHLEVEL_H_IMPLICIT #include "patchlevel.h"