/* perl.h
*
- * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
+ * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
+ * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 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.
# endif
#endif
-/* This logic needs to come after reading config.h, but before including
- proto.h */
-#ifdef IAMSUID
-# ifndef DOSUID
-# define DOSUID
-# endif
-#endif
-
-#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-# ifdef DOSUID
-# undef DOSUID
-# endif
-# ifdef IAMSUID
-# undef IAMSUID
-# define SETUID_SCRIPTS_ARE_SECURE_NOW_AND_IAMSUID
-# endif
-#endif
-
/* See L<perlguts/"The Perl API"> for detailed notes on
* PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
# endif
#endif
+#undef START_EXTERN_C
+#undef END_EXTERN_C
+#undef EXTERN_C
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
+#else
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C extern
+#endif
+
#ifdef PERL_GLOBAL_STRUCT
# ifndef PERL_GET_VARS
# ifdef PERL_GLOBAL_STRUCT_PRIVATE
- extern struct perl_vars* Perl_GetVarsPrivate();
+ EXTERN_C 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
#endif
-#undef START_EXTERN_C
-#undef END_EXTERN_C
-#undef EXTERN_C
-#ifdef __cplusplus
-# define START_EXTERN_C extern "C" {
-# define END_EXTERN_C }
-# define EXTERN_C extern "C"
-#else
-# define START_EXTERN_C
-# define END_EXTERN_C
-# 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
/* gcc (-ansi) -pedantic doesn't allow gcc statement expressions,
* g++ allows them but seems to have problems with them
- * (insane errors ensue). */
-#if defined(PERL_GCC_PEDANTIC) || (defined(__GNUC__) && defined(__cplusplus))
+ * (insane errors ensue).
+ * g++ does not give insane errors now (RMB 2008-01-30, gcc 4.2.2).
+ */
+#if defined(PERL_GCC_PEDANTIC) || \
+ (defined(__GNUC__) && defined(__cplusplus) && \
+ ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 2))))
# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
# endif
# include <unistd.h>
#endif
+/* for WCOREDUMP */
+#ifdef I_SYS_WAIT
+# include <sys/wait.h>
+#endif
+
#ifdef __SYMBIAN32__
# undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */
#endif
#define PERL_USES_PL_PIDSTATUS
#endif
-#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) && !defined(MACOS_TRADITIONAL)
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__)
#define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
#endif
# define MALLOC_CHECK_TAINT(argc,argv,env)
#endif /* MYMALLOC */
+/* diag_listed_as: "-T" is on the #! line, it must also be used on the command line */
#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}")
# include <sys/stat.h>
#endif
+/* Microsoft VC's sys/stat.h defines all S_Ixxx macros except S_IFIFO.
+ This definition should ideally go into win32/win32.h, but S_IFIFO is
+ used later here in perl.h before win32/win32.h is being included. */
+#if !defined(S_IFIFO) && defined(_S_IFIFO)
+# define S_IFIFO _S_IFIFO
+#endif
+
/* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
like UTekV) are broken, sometimes giving false positives. Undefine
them here and let the code below set them to proper values.
set_errno(errcode); \
set_vaxc_errno(vmserrcode); \
} STMT_END
+# define dSAVEDERRNO int saved_errno; unsigned saved_vms_errno
+# define dSAVE_ERRNO int saved_errno = errno; unsigned saved_vms_errno = vaxc$errno
+# define SAVE_ERRNO ( saved_errno = errno, saved_vms_errno = vaxc$errno )
+# define RESTORE_ERRNO SETERRNO(saved_errno, saved_vms_errno)
+
# define LIB_INVARG LIB$_INVARG
# define RMS_DIR RMS$_DIR
# define RMS_FAC RMS$_FAC
# define SS_NORMAL SS$_NORMAL
#else
# define SETERRNO(errcode,vmserrcode) (errno = (errcode))
+# define dSAVEDERRNO int saved_errno
+# define dSAVE_ERRNO int saved_errno = errno
+# define SAVE_ERRNO (saved_errno = errno)
+# define RESTORE_ERRNO (errno = saved_errno)
+
# define LIB_INVARG 0
# define RMS_DIR 0
# define RMS_FAC 0
#endif
#define ERRSV GvSV(PL_errgv)
-/* FIXME? Change the assignments to PL_defgv to instantiate GvSV? */
-#define DEFSV GvSVn(PL_defgv)
+#ifdef PERL_CORE
+# define DEFSV (0 + GvSVn(PL_defgv))
+#else
+# define DEFSV GvSVn(PL_defgv)
+#endif
+#define DEFSV_set(sv) (GvSV(PL_defgv) = (sv))
#define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */
# define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH)
#endif
-/* BeOS 5.0
seems to define S_IREAD and S_IWRITE in <posix/fcntl.h>
+/* BeOS 5.0
and Haiku R1 seem to define S_IREAD and S_IWRITE in <posix/fcntl.h>
* which would get included through <sys/file.h >, but that is 3000
* lines in the future. --jhi */
-#if !defined(S_IREAD) && !defined(__BEOS__)
+#if !defined(S_IREAD) && !(defined(__BEOS__) || defined(__HAIKU__))
# define S_IREAD S_IRUSR
#endif
-#if !defined(S_IWRITE) && !defined(__BEOS__)
+#if !defined(S_IWRITE) && !(defined(__BEOS__) || defined(__HAIKU__))
# define S_IWRITE S_IWUSR
#endif
# endif
#endif
-#if defined(OS2) || defined(MACOS_TRADITIONAL)
+#if defined(OS2)
# include "iperlsys.h"
#endif
# define ISHISH "symbian"
#endif
-#if defined(MACOS_TRADITIONAL)
-# include "macos/macish.h"
-# ifndef NO_ENVIRON_ARRAY
-# define NO_ENVIRON_ARRAY
-# endif
-# define ISHISH "macos classic"
-#endif
-#if defined(__BEOS__)
+#if defined(__HAIKU__)
+# include "haiku/haikuish.h"
+# define ISHISH "haiku"
+#elif defined(__BEOS__)
# include "beos/beosish.h"
# define ISHISH "beos"
#endif
# if HAS_FLOATINGPOINT_H
# include <floatingpoint.h>
# endif
-# define PERL_FPU_INIT fpsetmask(0)
+/* Some operating systems have this as a macro, which in turn expands to a comma
+ expression, and the last sub-expression is something that gets calculated,
+ and then they have the gall to warn that a value computed is not used. Hence
+ cast to void. */
+# define PERL_FPU_INIT (void)fpsetmask(0)
# else
# if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
# define PERL_FPU_INIT PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN)
# define PERL_SYS_INIT3_BODY(argvp,argcp,envp) PERL_SYS_INIT_BODY(argvp,argcp)
#endif
+/*
+=for apidoc Am|void|PERL_SYS_INIT|int argc|char** argv
+Provides system-specific tune up of the C runtime environment necessary to
+run Perl interpreters. This should be called only once, before creating
+any Perl interpreters.
+
+=for apidoc Am|void|PERL_SYS_INIT3|int argc|char** argv|char** env
+Provides system-specific tune up of the C runtime environment necessary to
+run Perl interpreters. This should be called only once, before creating
+any Perl interpreters.
+
+=for apidoc Am|void|PERL_SYS_TERM|
+Provides system-specific clean up of the C runtime environment after
+running Perl interpreters. This should be called only once, after
+freeing any remaining Perl interpreters.
+
+=cut
+ */
+
#define PERL_SYS_INIT(argc, argv) Perl_sys_init(argc, argv)
#define PERL_SYS_INIT3(argc, argv, env) Perl_sys_init3(argc, argv, env)
#define PERL_SYS_TERM() Perl_sys_term()
#ifndef PERL_MICRO
#if defined __GNUC__ && !defined(__INTEL_COMPILER)
+# if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */
+# define HASATTRIBUTE_DEPRECATED
+# endif
# if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
# define HASATTRIBUTE_FORMAT
# if defined __MINGW32__
} 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, 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.
+ * the NATIVE error status based on it.
+ *
+ * When in the default mode to comply with the Perl VMS documentation,
+ * 0 is a success and 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
STMT_START { \
I32 evalue = (I32)n; \
PL_statusvalue = evalue; \
- 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); \
+ if (MY_POSIX_EXIT) { \
+ if (evalue <= 0xFF00) { \
+ if (evalue > 0xFF) \
+ evalue = (evalue >> child_offset_bits) & 0xFF; \
+ PL_statusvalue_vms = \
+ (C_FAC_POSIX | (evalue << 3 ) | \
+ ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \
+ } else /* forgive them Perl, for they have sinned */ \
+ PL_statusvalue_vms = evalue; \
+ } else { \
+ if (evalue == 0) \
+ PL_statusvalue_vms = SS$_NORMAL; \
+ else if (evalue <= 0xFF00) \
+ 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; \
+ } \
+ 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.
* actual exit code will can be retrieved by the calling program or
* shell.
*
+ * A POSIX exit code is from 0 to 255. If the exit code is higher
+ * than this, it needs to be assumed that it is a VMS exit code and
+ * passed through.
*/
# define STATUS_EXIT_SET(n) \
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); \
+ if (evalue > 255) PL_statusvalue_vms = evalue; else { \
+ 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); \
# define MEMBER_TO_FPTR(name) name
#endif
+#ifndef PERL_CORE
/* format to use for version numbers in file/directory names */
/* XXX move to Configure? */
-#ifndef PERL_FS_VER_FMT
-# define PERL_FS_VER_FMT "%d.%d.%d"
+/* This was only ever used for the current version, and that can be done at
+ compile time, as PERL_FS_VERSION, so should we just delete it? */
+# ifndef PERL_FS_VER_FMT
+# define PERL_FS_VER_FMT "%d.%d.%d"
+# endif
+#endif
+
+#ifndef PERL_FS_VERSION
+# define PERL_FS_VERSION PERL_VERSION_STRING
#endif
/* This defines a way to flush all output buffers. This may be a
# endif
#endif
+#if !defined(PERL_CORE) && !defined(PERL_NO_SHORT_NAMES)
+# if defined(PERL_IMPLICIT_CONTEXT)
+# define pmflag(a,b) Perl_pmflag(aTHX_ a,b)
+# else
+# define pmflag Perl_pmflag
+# endif
+#endif
+
+#ifdef HASATTRIBUTE_DEPRECATED
+# define __attribute__deprecated__ __attribute__((deprecated))
+#endif
#ifdef HASATTRIBUTE_FORMAT
# define __attribute__format__(x,y,z) __attribute__((format(x,y,z)))
#endif
#endif
/* If we haven't defined the attributes yet, define them to blank. */
+#ifndef __attribute__deprecated__
+# define __attribute__deprecated__
+#endif
#ifndef __attribute__format__
# define __attribute__format__(x,y,z)
#endif
#endif /* threading */
#endif /* AIX */
-#if !defined(OS2) && !defined(MACOS_TRADITIONAL)
+#if !defined(OS2)
# include "iperlsys.h"
#endif
};
#endif
+/* macros to define bit-fields in structs. */
+#ifndef PERL_BITFIELD8
+# define PERL_BITFIELD8 unsigned
+#endif
+#ifndef PERL_BITFIELD16
+# define PERL_BITFIELD16 unsigned
+#endif
+#ifndef PERL_BITFIELD32
+# define PERL_BITFIELD32 unsigned
+#endif
+
#include "sv.h"
#include "regexp.h"
#include "util.h"
#include "utf8.h"
/* defined in sv.c, but also used in [ach]v.c */
-#undef _XPV_ALLOCATED_HEAD
#undef _XPV_HEAD
#undef _XPVMG_HEAD
#undef _XPVCV_COMMON
#define DEBUG_H_FLAG 0x00002000 /* 8192 */
#define DEBUG_X_FLAG 0x00004000 /* 16384 */
#define DEBUG_D_FLAG 0x00008000 /* 32768 */
-#define DEBUG_S_FLAG 0x00010000 /* 65536 */
+/* 0x00010000 is unused, used to be S */
#define DEBUG_T_FLAG 0x00020000 /* 131072 */
#define DEBUG_R_FLAG 0x00040000 /* 262144 */
#define DEBUG_J_FLAG 0x00080000 /* 524288 */
#define DEBUG_C_FLAG 0x00200000 /*2097152 */
#define DEBUG_A_FLAG 0x00400000 /*4194304 */
#define DEBUG_q_FLAG 0x00800000 /*8388608 */
-#define DEBUG_MASK 0x00FFEFFF /* mask of all the standard flags */
+#define DEBUG_M_FLAG 0x01000000 /*16777216*/
+#define DEBUG_B_FLAG 0x02000000 /*33554432*/
+#define DEBUG_MASK 0x03FEEFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal
# define DEBUG_H_TEST_ (PL_debug & DEBUG_H_FLAG)
# define DEBUG_X_TEST_ (PL_debug & DEBUG_X_FLAG)
# define DEBUG_D_TEST_ (PL_debug & DEBUG_D_FLAG)
-# define DEBUG_S_TEST_ (PL_debug & DEBUG_S_FLAG)
# define DEBUG_T_TEST_ (PL_debug & DEBUG_T_FLAG)
# define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG)
# define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
# define DEBUG_C_TEST_ (PL_debug & DEBUG_C_FLAG)
# define DEBUG_A_TEST_ (PL_debug & DEBUG_A_FLAG)
# define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
+# define DEBUG_M_TEST_ (PL_debug & DEBUG_M_FLAG)
+# define DEBUG_B_TEST_ (PL_debug & DEBUG_B_FLAG)
# define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
# define DEBUG_Uv_TEST_ (DEBUG_U_TEST_ && DEBUG_v_TEST_)
# define DEBUG_H_TEST DEBUG_H_TEST_
# define DEBUG_X_TEST DEBUG_X_TEST_
# define DEBUG_D_TEST DEBUG_D_TEST_
-# define DEBUG_S_TEST DEBUG_S_TEST_
# define DEBUG_T_TEST DEBUG_T_TEST_
# define DEBUG_R_TEST DEBUG_R_TEST_
# define DEBUG_J_TEST DEBUG_J_TEST_
# define DEBUG_C_TEST DEBUG_C_TEST_
# define DEBUG_A_TEST DEBUG_A_TEST_
# define DEBUG_q_TEST DEBUG_q_TEST_
+# define DEBUG_M_TEST DEBUG_M_TEST_
+# define DEBUG_B_TEST DEBUG_B_TEST_
# define DEBUG_Xv_TEST DEBUG_Xv_TEST_
# define DEBUG_Uv_TEST DEBUG_Uv_TEST_
# define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a)
# define DEBUG_Uv(a) DEBUG__(DEBUG_Uv_TEST, a)
-# define DEBUG_S(a)
-
# define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a)
# define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a)
# define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a)
# define DEBUG_C(a) DEBUG__(DEBUG_C_TEST, a)
# define DEBUG_A(a) DEBUG__(DEBUG_A_TEST, a)
# define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a)
+# define DEBUG_M(a) DEBUG__(DEBUG_M_TEST, a)
+# define DEBUG_B(a) DEBUG__(DEBUG_B_TEST, a)
#else /* DEBUGGING */
# define DEBUG_H_TEST (0)
# define DEBUG_X_TEST (0)
# define DEBUG_D_TEST (0)
-# define DEBUG_S_TEST (0)
# define DEBUG_T_TEST (0)
# define DEBUG_R_TEST (0)
# define DEBUG_J_TEST (0)
# define DEBUG_C_TEST (0)
# define DEBUG_A_TEST (0)
# define DEBUG_q_TEST (0)
+# define DEBUG_M_TEST (0)
+# define DEBUG_B_TEST (0)
# define DEBUG_Xv_TEST (0)
# define DEBUG_Uv_TEST (0)
# define DEBUG_H(a)
# define DEBUG_X(a)
# define DEBUG_D(a)
-# define DEBUG_S(a)
# define DEBUG_T(a)
# define DEBUG_R(a)
# define DEBUG_v(a)
# define DEBUG_C(a)
# define DEBUG_A(a)
# define DEBUG_q(a)
+# define DEBUG_M(a)
+# define DEBUG_B(a)
# define DEBUG_Xv(a)
# define DEBUG_Uv(a)
#endif /* DEBUGGING */
#endif
#ifdef USE_PERLIO
-EXTERN_C void PerlIO_teardown();
+EXTERN_C void PerlIO_teardown(void);
# ifdef USE_ITHREADS
# define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex)
# define PERLIO_TERM \
(MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
%MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
+#else
+# define sTHX 0
#endif
#ifdef PERL_TRACK_MEMPOOL
# define INIT_TRACK_MEMPOOL(header, interp)
#endif
+#ifdef I_MALLOCMALLOC
+/* Needed for malloc_size(), malloc_good_size() on some systems */
+# include <malloc/malloc.h>
+#endif
+
+#ifdef MYMALLOC
+# define Perl_safesysmalloc_size(where) Perl_malloced_size(where)
+#else
+# ifdef HAS_MALLOC_SIZE
+# ifdef PERL_TRACK_MEMPOOL
+# define Perl_safesysmalloc_size(where) \
+ (malloc_size(((char *)(where)) - sTHX) - sTHX)
+# else
+# define Perl_safesysmalloc_size(where) malloc_size(where)
+# endif
+# endif
+# ifdef HAS_MALLOC_GOOD_SIZE
+# ifdef PERL_TRACK_MEMPOOL
+# define Perl_malloc_good_size(how_much) \
+ (malloc_good_size((how_much) + sTHX) - sTHX)
+# else
+# define Perl_malloc_good_size(how_much) malloc_good_size(how_much)
+# endif
+# else
+/* Having this as the identity operation makes some code simpler. */
+# define Perl_malloc_good_size(how_much) (how_much)
+# endif
+#endif
typedef int (CPERLscope(*runops_proc_t)) (pTHX);
typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv);
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");
+ INIT("Can't use string (\"%.32s\"%s) 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");
+ INIT("Can't use string (\"%" SVf32 "\"%s) 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[]
EXTCONST char PL_uudmap[256] =
#include "uudmap.h"
;
+EXTCONST char PL_bitcount[256] =
+# include "bitcount.h"
+;
EXTCONST char* const PL_sig_name[] = { SIG_NAME };
EXTCONST int PL_sig_num[] = { SIG_NUM };
#else
EXTCONST char PL_uudmap[256];
+EXTCONST char PL_bitcount[256];
EXTCONST char* const PL_sig_name[];
EXTCONST int PL_sig_num[];
#endif
#ifdef DOINIT
EXTCONST char* const PL_block_type[] = {
"NULL",
- "SUB",
- "EVAL",
"WHEN",
- "SUBST",
"BLOCK",
- "FORMAT",
"GIVEN",
"LOOP_FOR",
"LOOP_PLAIN",
"LOOP_LAZYSV",
"LOOP_LAZYIV",
+ "SUB",
+ "FORMAT",
+ "EVAL",
+ "SUBST"
};
#else
EXTCONST char* PL_block_type[];
want_vtbl_utf8,
want_vtbl_symtab,
want_vtbl_arylen_p,
- want_vtbl_hintselem
+ want_vtbl_hintselem,
+ want_vtbl_hints
};
#define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */
#define HINT_UTF8 0x00800000 /* utf8 pragma */
+#define HINT_NO_AMAGIC 0x01000000 /* overloading pragma */
+
/* The following are stored in $^H{sort}, not in PL_hints */
#define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */
#define HINT_SORT_QUICKSORT 0x00000001
typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*);
typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*);
-typedef void (*SVFUNC_t) (pTHX_ SV*);
-typedef I32 (*SVCOMPARE_t) (pTHX_ SV*, SV*);
+typedef void (*SVFUNC_t) (pTHX_ SV* const);
+typedef I32 (*SVCOMPARE_t) (pTHX_ SV* const, SV* const);
typedef void (*XSINIT_t) (pTHX);
typedef void (*ATEXIT_t) (pTHX_ void*);
typedef void (*XSUBADDR_t) (pTHX_ CV *);
typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
+typedef void(CPERLscope(*Perl_ophook_t))(pTHX_ OP*);
+typedef int (CPERLscope(*Perl_keyword_plugin_t))(pTHX_ char*, STRLEN, OP**);
+
+#define KEYWORD_PLUGIN_DECLINE 0
+#define KEYWORD_PLUGIN_STMT 1
+#define KEYWORD_PLUGIN_EXPR 2
/* Interpreter exitlist entry */
typedef struct exitlistentry {
#include "patchlevel.h"
#undef PERL_PATCHLEVEL_H_IMPLICIT
+#define PERL_VERSION_STRING STRINGIFY(PERL_REVISION) "." \
+ STRINGIFY(PERL_VERSION) "." \
+ STRINGIFY(PERL_SUBVERSION)
+
#ifdef PERL_GLOBAL_STRUCT
struct perl_vars {
# include "perlvars.h"
0
);
-/* For now, hints magic will also use vtbl_sig, because it is all 0 */
MGVTBL_SET(
PL_vtbl_sig,
0,
0
);
+MGVTBL_SET(
+ PL_vtbl_hints,
+ 0,
+ 0,
+ 0,
+ MEMBER_TO_FPTR(Perl_magic_clearhints),
+ 0,
+ 0,
+ 0,
+ 0
+);
+
#include "overload.h"
END_EXTERN_C
#define PERLDB_ALL (PERLDBf_SUB | PERLDBf_LINE | \
PERLDBf_NOOPT | PERLDBf_INTER | \
PERLDBf_SUBLINE| PERLDBf_SINGLE| \
- PERLDBf_NAMEEVAL| PERLDBf_NAMEANON )
- /* No _NONAME, _GOTO, _ASSERTION */
+ PERLDBf_NAMEEVAL| PERLDBf_NAMEANON | \
+ PERLDBf_SAVESRC)
+ /* No _NONAME, _GOTO */
#define PERLDBf_SUB 0x01 /* Debug sub enter/exit */
#define PERLDBf_LINE 0x02 /* Keep line # */
#define PERLDBf_NOOPT 0x04 /* Switch off optimizations */
#define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto */
#define PERLDBf_NAMEEVAL 0x100 /* Informative names for evals */
#define PERLDBf_NAMEANON 0x200 /* Informative names for anon subs */
+#define PERLDBf_SAVESRC 0x400 /* Save source lines into @{"_<$filename"} */
+#define PERLDBf_SAVESRC_NOSUBS 0x800 /* Including evals that generate no subrouties */
+#define PERLDBf_SAVESRC_INVALID 0x1000 /* Save source that did not compile */
#define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB))
#define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE))
#define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO))
#define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL))
#define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON))
-#define PERLDB_ASSERTION (PL_perldb && (PL_perldb & PERLDBf_ASSERTION))
+#define PERLDB_SAVESRC (PL_perldb && (PL_perldb & PERLDBf_SAVESRC))
+#define PERLDB_SAVESRC_NOSUBS (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS))
+#define PERLDB_SAVESRC_INVALID (PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID))
#ifdef USE_LOCALE_NUMERIC
#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(__VOS__) || defined(__CYGWIN__)
- /* BeOS has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect;
- * BeOS is always UNIXoid (LF), not DOSish (CRLF). */
+# 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). */
/* 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
# endif
#endif
-#ifdef IAMSUID
-
-#ifdef I_SYS_STATVFS
-# if defined(PERL_SCO) && !defined(_SVID3)
-# define _SVID3
-# endif
-# include <sys/statvfs.h> /* for f?statvfs() */
-#endif
-#ifdef I_SYS_MOUNT
-# include <sys/mount.h> /* for *BSD f?statfs() */
-#endif
-#ifdef I_MNTENT
-# include <mntent.h> /* for getmntent() */
-#endif
-#ifdef I_SYS_STATFS
-# include <sys/statfs.h> /* for some statfs() */
-#endif
-#ifdef I_SYS_VFS
-# ifdef __sgi
-# define sv IRIX_sv /* kludge: IRIX has an sv of its own */
-# endif
-# include <sys/vfs.h> /* for some statfs() */
-# ifdef __sgi
-# undef IRIX_sv
-# endif
-#endif
-#ifdef I_USTAT
-# include <ustat.h> /* for ustat() */
-#endif
-
-#if !defined(PERL_MOUNT_NOSUID) && defined(MOUNT_NOSUID)
-# define PERL_MOUNT_NOSUID MOUNT_NOSUID
-#endif
-#if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
-# define PERL_MOUNT_NOSUID MNT_NOSUID
-#endif
-#if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
-# define PERL_MOUNT_NOSUID MS_NOSUID
-#endif
-#if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
-# 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
# include <libutil.h> /* setproctitle() in some FreeBSDs */
#endif
#endif /* Include guard */
+#define CLEAR_ERRSV() STMT_START { sv_setpvn(ERRSV,"",0); if (SvMAGICAL(ERRSV)) { mg_free(ERRSV); } SvPOK_only(ERRSV); } STMT_END
+
/*
* Local variables:
* c-indentation-style: bsd
https://perl5.git.perl.org / perl5.git / blobdiff