X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=ea01ddad8cff79a0ef3ef5a04213e80858c122d6;hb=17fda5459df9207789e2c93a13c6057a90cf1f93;hp=fd34ea3044cf5af865f2fedced4581406d3fed96;hpb=9969cdde14140755eb30d589cbe9cc9376b9fe3d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index fd34ea3..ea01dda 100644 --- a/perl.h +++ b/perl.h @@ -148,12 +148,14 @@ # ifndef MULTIPLICITY # define MULTIPLICITY # endif -# define pTHX register PerlInterpreter *my_perl PERL_UNUSED_DECL +# define tTHX PerlInterpreter* +# define sTHX (sizeof(tTHX) + (MEM_ALIGNBYTES - sizeof(tTHX)%MEM_ALIGNBYTES) % MEM_ALIGNBYTES) +# define pTHX register tTHX my_perl PERL_UNUSED_DECL # define aTHX my_perl # ifdef PERL_GLOBAL_STRUCT -# define dTHXa(a) dVAR; pTHX = (PerlInterpreter*)a +# define dTHXa(a) dVAR; pTHX = (tTHX)a # else -# define dTHXa(a) pTHX = (PerlInterpreter*)a +# define dTHXa(a) pTHX = (tTHX)a # endif # ifdef PERL_GLOBAL_STRUCT # define dTHX dVAR; pTHX = PERL_GET_THX @@ -171,6 +173,11 @@ # define pTHX_7 8 # define pTHX_8 9 # define pTHX_9 10 +# if defined(DEBUGGING) && !defined(PERL_TRACK_MEMPOOL) +# define PERL_TRACK_MEMPOOL +# endif +#else +# undef PERL_TRACK_MEMPOOL #endif #define STATIC static @@ -190,6 +197,11 @@ #define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string) #define CALLREGFREE CALL_FPTR(PL_regfree) +/* XXX The PERL_UNUSED_DECL suffix is unfortunately rather inflexible: + * it assumes that in all compilers the way to suppress an "unused" + * warning is to have a suffix. In some compilers that might be a + * a compiler pragma, e.g. #pragma unused(varname). */ + #if defined(__SYMBIAN32__) && defined(__GNUC__) # ifdef __cplusplus # define PERL_UNUSED_DECL @@ -226,6 +238,9 @@ #define dNOOP extern int Perl___notused PERL_UNUSED_DECL #ifndef pTHX +/* Don't bother defining tTHX and sTHX; using them outside + * code guarded by PERL_IMPLICIT_CONTEXT is an error. + */ # define pTHX void # define pTHX_ # define aTHX @@ -385,7 +400,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) || defined(__SYMBIAN32__) +#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined(EPOC) || defined(NETWARE) || defined(__SYMBIAN32__) # define STANDARD_C 1 #endif @@ -810,6 +825,14 @@ int usleep(unsigned int); #define PERL_DONT_CREATE_GVSV #endif +#if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME) +#define PERL_USES_PL_PIDSTATUS +#endif + +#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) && !defined(MACOS_TRADITIONAL) +#define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION +#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 */ @@ -1397,6 +1420,16 @@ int sockatmark(int); # define sprintf UTS_sprintf_wrap #endif +/* For the times when you want the return value of sprintf, and you want it + to be the length. Can't have a thread variable passed in, because C89 has + no varargs macros. +*/ +#ifdef SPRINTF_RETURNS_STRLEN +# define my_sprintf sprintf +#else +# define my_sprintf Perl_my_sprintf +#endif + /* Configure gets this right but the UTS compiler gets it wrong. -- Hal Morris */ #ifdef UTS @@ -2547,7 +2580,7 @@ typedef pthread_key_t perl_key; # define STATUS_NATIVE PL_statusvalue_vms /* * vaxc$errno is only guaranteed to be valid if errno == EVMSERR, otherwise - * it's contents can not be trusted. Unfortunately, Perl seems to check + * its contents can not be trusted. Unfortunately, Perl seems to check * it on exit, so it when PL_statusvalue_vms is updated, vaxc$errno should * be updated also. */ @@ -2569,24 +2602,29 @@ typedef pthread_key_t perl_key; (((I32)PL_statusvalue_vms == -1 ? SS$_ABORT : PL_statusvalue_vms) | \ (VMSISH_HUSHED ? STS$M_INHIB_MSG : 0)) -/* STATUS_NATIVE_SET - takes a NATIVE status code and converts it to a - * UNIX/POSIX status value and updates both the native and PL_statusvalue - * as needed. This currently seems only exist for VMS and is used in the exit - * handling. - */ -# define STATUS_NATIVE_SET(n) STATUS_NATIVE_SET_PORC(n, 0) - -/* STATUS_NATIVE_CHILD_SET - same as STATUS_NATIVE_SET, but shifts the UNIX - * value over the correct number of bits to be a child status. Usually - * the number of bits is 8, but that could be platform dependent. The NATIVE - * status code is presumed to have either from a child process. +/* STATUS_NATIVE_CHILD_SET - Calculate UNIX status that matches the child + * exit code and shifts the UNIX value over the correct number of bits to + * be a child status. Usually the number of bits is 8, but that could be + * platform dependent. The NATIVE status code is presumed to have either + * from a child process. */ -# define STATUS_NATIVE_CHILD_SET(n) STATUS_NATIVE_SET_PORC(n, 1) +/* This is complicated. The child processes return a true native VMS + status which must be saved. But there is an assumption in Perl that + the UNIX child status has some relationship to errno values, so + Perl tries to translate it to text in some of the tests. + In order to get the string translation correct, for the error, errno + must be EVMSERR, but that generates a different text message + than what the test programs are expecting. So an errno value must + be derived from the native status value when an error occurs. + That will hide the true native status message. With this version of + perl, the true native child status can always be retrieved so that + is not a problem. But in this case, Pl_statusvalue and errno may + have different values in them. + */ - /* internal convert VMS status codes to UNIX error or status codes */ -# define STATUS_NATIVE_SET_PORC(n, _x) \ +# define STATUS_NATIVE_CHILD_SET(n) \ STMT_START { \ I32 evalue = (I32)n; \ if (evalue == EVMSERR) { \ @@ -2594,14 +2632,16 @@ typedef pthread_key_t perl_key; PL_statusvalue = evalue; \ } else { \ PL_statusvalue_vms = evalue; \ - if ((I32)PL_statusvalue_vms == -1) { \ + if (evalue == -1) { \ PL_statusvalue = -1; \ PL_statusvalue_vms = SS$_ABORT; /* Should not happen */ \ } else \ - PL_statusvalue = Perl_vms_status_to_unix(evalue, _x); \ + PL_statusvalue = Perl_vms_status_to_unix(evalue, 1); \ set_vaxc_errno(evalue); \ - set_errno(PL_statusvalue); \ - if (_x) PL_statusvalue = PL_statusvalue << child_offset_bits; \ + if ((PL_statusvalue_vms & C_FAC_POSIX) == C_FAC_POSIX) \ + set_errno(EVMSERR); \ + else set_errno(Perl_vms_status_to_unix(evalue, 0)); \ + PL_statusvalue = PL_statusvalue << child_offset_bits; \ } \ } STMT_END @@ -2620,58 +2660,102 @@ typedef pthread_key_t perl_key; # define STATUS_UNIX_SET(n) \ STMT_START { \ I32 evalue = (I32)n; \ - PL_statusvalue = evalue; \ + PL_statusvalue = evalue; \ if (PL_statusvalue != -1) { \ - if (PL_statusvalue != EVMSERR) { \ - PL_statusvalue &= 0xFFFF; \ - PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \ - } \ - else { \ - PL_statusvalue_vms = vaxc$errno; \ - } \ + if (PL_statusvalue != EVMSERR) { \ + PL_statusvalue &= 0xFFFF; \ + if (MY_POSIX_EXIT) \ + PL_statusvalue_vms=PL_statusvalue ? SS$_ABORT : SS$_NORMAL;\ + else PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \ + } \ + else { \ + PL_statusvalue_vms = vaxc$errno; \ + } \ } \ - else PL_statusvalue_vms = SS$_ABORT; \ - set_vaxc_errno(evalue); \ + else PL_statusvalue_vms = SS$_ABORT; \ + set_vaxc_errno(PL_statusvalue_vms); \ } STMT_END /* STATUS_UNIX_EXIT_SET - Takes a UNIX/POSIX exit code and sets * the NATIVE error status based on it. It does not assume that - * the UNIX/POSIX exit codes have any relationship to errno - * values and are only being encoded into the NATIVE form so - * that they can be properly passed through to the calling - * program or shell. + * the UNIX/POSIX exit codes have any relationship to errno, except + * that 0 indicates a success. When in the default mode to comply + * with the Perl VMS documentation, any other code sets the NATIVE + * status to a failure code of SS$_ABORT. + * + * In the new POSIX EXIT mode, native status will be set so that the + * actual exit code will can be retrieved by the calling program or + * shell. + * + * If the exit code is not clearly a UNIX parent or child exit status, + * it will be passed through as a VMS status. */ -# define STATUS_UNIX_EXIT_SET(n) \ +# define STATUS_UNIX_EXIT_SET(n) \ STMT_START { \ I32 evalue = (I32)n; \ PL_statusvalue = evalue; \ - if (PL_statusvalue != -1) { \ - if (PL_statusvalue != EVMSERR) { \ - if (PL_statusvalue < 256) { \ - if (PL_statusvalue == 0) \ - PL_statusvalue_vms == SS$_NORMAL; \ - else \ - PL_statusvalue_vms = MY_POSIX_EXIT ? \ - (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \ - (STS$K_ERROR | STS$M_INHIB_MSG) : 0) : evalue; \ - } else { /* forgive them Perl, for they have sinned */ \ - PL_statusvalue_vms = evalue; \ - } /* And obviously used a VMS status value instead of UNIX */ \ - PL_statusvalue = EVMSERR; \ - } \ - else { \ - PL_statusvalue_vms = vaxc$errno; \ - } \ + if (evalue != -1) { \ + if (evalue <= 0xFF00) { \ + if (evalue > 0xFF) \ + evalue = (evalue >> child_offset_bits) & 0xFF; \ + if (evalue == 0) \ + PL_statusvalue_vms == SS$_NORMAL; \ + else \ + if (MY_POSIX_EXIT) \ + PL_statusvalue_vms = \ + (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \ + (STS$K_ERROR | STS$M_INHIB_MSG) : 1); \ + else \ + PL_statusvalue_vms = SS$_ABORT; \ + } else { /* forgive them Perl, for they have sinned */ \ + if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \ + else PL_statusvalue_vms = vaxc$errno; \ + /* And obviously used a VMS status value instead of UNIX */ \ + PL_statusvalue = EVMSERR; \ + } \ } \ else PL_statusvalue_vms = SS$_ABORT; \ set_vaxc_errno(PL_statusvalue_vms); \ } STMT_END + + /* STATUS_EXIT_SET - Takes a NATIVE/UNIX/POSIX exit code + * and sets the NATIVE error status based on it. This special case + * is needed to maintain compatibility with past VMS behavior. + * + * In the default mode on VMS, this number is passed through as + * both the NATIVE and UNIX status. Which makes it different + * that the STATUS_UNIX_EXIT_SET. + * + * In the new POSIX EXIT mode, native status will be set so that the + * actual exit code will can be retrieved by the calling program or + * shell. + * + */ + +# define STATUS_EXIT_SET(n) \ + STMT_START { \ + I32 evalue = (I32)n; \ + PL_statusvalue = evalue; \ + if (MY_POSIX_EXIT) \ + PL_statusvalue_vms = \ + (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \ + (STS$K_ERROR | STS$M_INHIB_MSG) : 1); \ + else \ + PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \ + set_vaxc_errno(PL_statusvalue_vms); \ + } STMT_END + + + /* This macro forces a success status */ # define STATUS_ALL_SUCCESS \ (PL_statusvalue = 0, PL_statusvalue_vms = SS$_NORMAL) + + /* This macro forces a failure status */ # define STATUS_ALL_FAILURE (PL_statusvalue = 1, \ vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \ (C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT) + #else # define STATUS_NATIVE PL_statusvalue_posix # if defined(WCOREDUMP) @@ -2718,6 +2802,7 @@ typedef pthread_key_t perl_key; PL_statusvalue &= 0xFFFF; \ } STMT_END # define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n) +# define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n) # define STATUS_CURRENT STATUS_UNIX # define STATUS_EXIT STATUS_UNIX # define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0) @@ -2888,11 +2973,16 @@ typedef pthread_key_t perl_key; #ifndef IOCPARM_LEN # ifdef IOCPARM_MASK - /* on BSDish systes we're safe */ + /* on BSDish systems we're safe */ # define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) # else +# if defined(_IOC_SIZE) && defined(__GLIBC__) + /* on Linux systems we're safe */ +# define IOCPARM_LEN(x) _IOC_SIZE(x) +# else /* otherwise guess at what's safe */ -# define IOCPARM_LEN(x) 256 +# define IOCPARM_LEN(x) 256 +# endif # endif #endif @@ -3710,10 +3800,8 @@ 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[\\]^_"); @@ -3931,6 +4019,9 @@ EXTCONST char* const PL_block_type[] = { "LOOP", "SUBST", "BLOCK", + "FORMAT", + "GIVEN", + "WHEN" }; #else EXTCONST char* PL_block_type[]; @@ -4046,6 +4137,9 @@ enum { /* pass one of these to get_vtbl */ #define HINT_ASSERTING 0x01000000 #define HINT_ASSERTIONSSEEN 0x02000000 +#define HINT_HH_FOR_EVAL 0x04000000 /* Squirrel a copy of %^H away + * with every eval "string" */ + /* The following are stored in $sort::hints, not in PL_hints */ #define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */ #define HINT_SORT_QUICKSORT 0x00000001 @@ -4637,7 +4731,10 @@ enum { to_sv_amg, to_av_amg, to_hv_amg, to_gv_amg, to_cv_amg, iter_amg, - int_amg, DESTROY_amg, + int_amg, smart_amg, + + /* Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry */ + DESTROY_amg, max_amg_code /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */ }; @@ -4684,7 +4781,8 @@ EXTCONST char * const PL_AMG_names[NofAMmeth] = { "(${}", "(@{}", "(%{}", "(*{}", "(&{}", "(<>", - "(int", "DESTROY", + "(int", "(~~", + "DESTROY" }; #else EXTCONST char * PL_AMG_names[NofAMmeth]; @@ -5314,6 +5412,17 @@ extern void moncontrol(int); #pragma message disable (mainparm) /* Perl uses the envp in main(). */ #endif +#define do_open(g, n, l, a, rm, rp, sf) \ + do_openn(g, n, l, a, rm, rp, sf, (SV **) NULL, 0) +#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION +# define do_exec(cmd) do_exec3(cmd,0,0) +#endif +#ifdef OS2 +# define do_aexec Perl_do_aexec +#else +# define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0) +#endif + /* and finally... */ #define PERL_PATCHLEVEL_H_IMPLICIT #include "patchlevel.h"