X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=efdf7edb7fcbd19dfe332f6ca91744e73c8bdd2e;hb=e2e4dbf1c0b3171079efbd13aea2730e8a9bfda5;hp=d8d3878e9b6670f544adce525dbd9f9191f2bc34;hpb=8d2f45362e368d7dd455b476c924dcbcc02d845b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index d8d3878..efdf7ed 100644 --- a/perl.h +++ b/perl.h @@ -190,13 +190,37 @@ #define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string) #define CALLREGFREE CALL_FPTR(PL_regfree) -#define PERL_UNUSED_DECL __attribute__unused__ +#if defined(SYMBIAN) && defined(__GNUC__) +# ifdef __cplusplus +# define PERL_UNUSED_DECL +# else +# define PERL_UNUSED_DECL __attribute__((unused)) +# endif +#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) ((void)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 @@ -306,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 ??? */ @@ -780,6 +804,12 @@ int usleep(unsigned int); #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 */ @@ -789,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) @@ -1095,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 */ @@ -1459,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 @@ -2087,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; @@ -2281,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 @@ -2296,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 @@ -2343,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++ @@ -2399,17 +2547,25 @@ typedef pthread_key_t perl_key; # define STATUS_NATIVE PL_statusvalue_vms # define STATUS_NATIVE_EXPORT \ (((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms) | (VMSISH_HUSHED ? 0x10000000 : 0)) -# define STATUS_NATIVE_SET(n) \ +# define STATUS_NATIVE_SET(n) STATUS_NATIVE_SET_PORC(n, 0) +# define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET_PORC(n, 1) +# define STATUS_NATIVE_SET_PORC(n, _x) \ STMT_START { \ - PL_statusvalue_vms = (n); \ - if ((I32)PL_statusvalue_vms == -1) \ + I32 evalue = (I32)n; \ + if (evalue == EVMSERR) { \ + PL_statusvalue_vms = vaxc$errno; \ + PL_statusvalue = evalue; \ + } \ + else { \ + PL_statusvalue_vms = evalue; \ + if ((I32)PL_statusvalue_vms == -1) \ PL_statusvalue = -1; \ - else if (PL_statusvalue_vms & STS$M_SUCCESS) \ - PL_statusvalue = 0; \ - else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0) \ - PL_statusvalue = 1 << 8; \ - else \ - PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8; \ + else \ + PL_statusvalue = vms_status_to_unix(evalue); \ + set_vaxc_errno(evalue); \ + set_errno(PL_statusvalue); \ + if (_x) PL_statusvalue = PL_statusvalue << 8; \ + } \ } STMT_END # ifdef VMSISH_STATUS # define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX) @@ -2420,8 +2576,13 @@ typedef pthread_key_t perl_key; STMT_START { \ PL_statusvalue = (n); \ if (PL_statusvalue != -1) { \ - PL_statusvalue &= 0xFFFF; \ - PL_statusvalue_vms = PL_statusvalue ? 44 : 1; \ + if (PL_statusvalue != EVMSERR) { \ + PL_statusvalue &= 0xFFFF; \ + PL_statusvalue_vms = PL_statusvalue ? 44 : 1; \ + } \ + else { \ + PL_statusvalue_vms = vaxc$errno; \ + } \ } \ else PL_statusvalue_vms = -1; \ } STMT_END @@ -2431,6 +2592,7 @@ typedef pthread_key_t perl_key; # define STATUS_NATIVE PL_statusvalue_posix # define STATUS_NATIVE_EXPORT STATUS_NATIVE # if defined(WCOREDUMP) +# define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n) # define STATUS_NATIVE_SET(n) \ STMT_START { \ PL_statusvalue_posix = (n); \ @@ -2444,6 +2606,7 @@ typedef pthread_key_t perl_key; } \ } STMT_END # elif defined(WIFEXITED) +# define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n) # define STATUS_NATIVE_SET(n) \ STMT_START { \ PL_statusvalue_posix = (n); \ @@ -2456,6 +2619,7 @@ typedef pthread_key_t perl_key; } \ } STMT_END # else +# define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET(n) # define STATUS_NATIVE_SET(n) \ STMT_START { \ PL_statusvalue_posix = (n); \ @@ -2530,71 +2694,58 @@ typedef pthread_key_t perl_key; # define PERL_SET_THX(t) PERL_SET_CONTEXT(t) #endif -/* This replaces the previous %_ "hack" by the "%-p" hack +/* + This replaces the previous %_ "hack" by the "%p" hacks. All that is required is that the perl source does not - use "%-p" or "%-p" format. These format will - still work in perl code. RMB 2005/05/17 + 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 "-p" + +#ifndef SVf_ +# define SVf_(n) "-" STRINGIFY(n) "p" #endif -#ifndef SVf_precision -# define SVf_precision(n) "-" n "p" +#ifndef SVf +# define SVf "-p" #endif #ifndef SVf32 -# define SVf32 SVf_precision("32") +# define SVf32 SVf_(32) #endif #ifndef SVf256 -# define SVf256 SVf_precision("256") -#endif - -#ifndef UVf -# define UVf UVuf +# define SVf256 SVf_(256) #endif -#ifndef DieNull -# define DieNull Perl_vdie(aTHX_ Nullch, Null(va_list *)) +#ifndef vdNUMBER +# define vdNUMBER 1 #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 */ -#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 + +#ifndef VDf +# if vdNUMBER +# define VDf STRINGIFY(vdNUMBER) "p" +# else +# define VDf "vd" # endif #endif - + +#ifndef UVf +# define UVf UVuf +#endif #ifdef HASATTRIBUTE_FORMAT # define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) #endif #ifdef HASATTRIBUTE_MALLOC -# define __attribute__malloc__ __attribute__((malloc)) +# define __attribute__malloc__ __attribute__((__malloc__)) #endif #ifdef HASATTRIBUTE_NONNULL # define __attribute__nonnull__(a) __attribute__((nonnull(a))) @@ -2778,9 +2929,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; }; @@ -3170,14 +3324,16 @@ Gid_t getegid (void); #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 */ #define assert(what) PERL_DEB( \ ((what) ? ((void) 0) : \ - (Perl_croak(aTHX_ "Assertion " STRINGIFY(what) " failed: file \"%s\", line %d", \ - __FILE__, __LINE__), \ + (Perl_croak(aTHX_ "Assertion %s failed: file \"" __FILE__ \ + "\", line %d", STRINGIFY(what), __LINE__), \ PerlProc_exit(1), \ (void) 0))) #endif @@ -3328,7 +3484,7 @@ char *getlogin (void); #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */ #define UNLINK unlnk -I32 unlnk (char*); +I32 unlnk (const char*); #else #define UNLINK PerlLIO_unlink #endif @@ -3770,7 +3926,8 @@ enum { /* pass one of these to get_vtbl */ want_vtbl_regdatum, want_vtbl_backref, want_vtbl_utf8, - want_vtbl_symtab + want_vtbl_symtab, + want_vtbl_arylen_p }; /* Note: the lowest 8 bits are reserved for @@ -3942,8 +4099,8 @@ struct tempsym; /* defined in pp_pack.c */ #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" @@ -3996,8 +4153,10 @@ START_EXTERN_C #ifdef DOINIT # 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 # 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( @@ -4118,7 +4277,7 @@ MGVTBL_SET( NULL ); -MGVTBL_SET( +MGVTBL_SET_CONST_MAGIC_GET( PL_vtbl_arylen, MEMBER_TO_FPTR(Perl_magic_getarylen), MEMBER_TO_FPTR(Perl_magic_setarylen), @@ -4130,6 +4289,17 @@ MGVTBL_SET( ); 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), @@ -4688,26 +4858,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 = (char *) new_chunk; \ - PL_nice_chunk_size = new_chunk_size; \ - } else { \ - Safefree(chunk); \ - } \ - UNLOCK_SV_MUTEX; \ - } STMT_END - #ifdef HAS_SEM # include # include @@ -5077,8 +5227,8 @@ extern void moncontrol(int); * but also beware since this evaluates its argument twice, so no x++. */ #define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) -#ifdef __osf__ -#pragma message disable (mainparm) /* We have the envp in main(). */ +#if defined(__DECC) && defined(__osf__) +#pragma message disable (mainparm) /* Perl uses the envp in main(). */ #endif /* and finally... */