/* 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
+#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. */
#define CALLREGCOMP_ENG(prog, sv, flags) \
CALL_FPTR(((prog)->comp))(aTHX_ sv, flags)
#define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,screamer,data,flags) \
- CALL_FPTR((prog)->engine->exec)(aTHX_ (prog),(stringarg),(strend), \
+ CALL_FPTR(RX_ENGINE(prog)->exec)(aTHX_ (prog),(stringarg),(strend), \
(strbeg),(minend),(screamer),(data),(flags))
#define CALLREG_INTUIT_START(prog,sv,strpos,strend,flags,data) \
- CALL_FPTR((prog)->engine->intuit)(aTHX_ (prog), (sv), (strpos), \
+ CALL_FPTR(RX_ENGINE(prog)->intuit)(aTHX_ (prog), (sv), (strpos), \
(strend),(flags),(data))
#define CALLREG_INTUIT_STRING(prog) \
- CALL_FPTR((prog)->engine->checkstr)(aTHX_ (prog))
-
-#define CALLREG_AS_STR(mg,lp,flags,haseval) \
- Perl_reg_stringify(aTHX_ (mg), (lp), (flags), (haseval))
-#define CALLREG_STRINGIFY(mg,lp,flags) CALLREG_AS_STR(mg,lp,flags,0)
+ CALL_FPTR(RX_ENGINE(prog)->checkstr)(aTHX_ (prog))
#define CALLREGFREE(prog) \
Perl_pregfree(aTHX_ (prog))
#define CALLREGFREE_PVT(prog) \
- if(prog) CALL_FPTR((prog)->engine->free)(aTHX_ (prog))
+ if(prog) CALL_FPTR(RX_ENGINE(prog)->free)(aTHX_ (prog))
#define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \
- CALL_FPTR((rx)->engine->numbered_buff_FETCH)(aTHX_ (rx),(paren),(usesv))
+ CALL_FPTR(RX_ENGINE(rx)->numbered_buff_FETCH)(aTHX_ (rx),(paren),(usesv))
#define CALLREG_NUMBUF_STORE(rx,paren,value) \
- CALL_FPTR((rx)->engine->numbered_buff_STORE)(aTHX_ (rx),(paren),(value))
+ CALL_FPTR(RX_ENGINE(rx)->numbered_buff_STORE)(aTHX_ (rx),(paren),(value))
#define CALLREG_NUMBUF_LENGTH(rx,sv,paren) \
- CALL_FPTR((rx)->engine->numbered_buff_LENGTH)(aTHX_ (rx),(sv),(paren))
+ CALL_FPTR(RX_ENGINE(rx)->numbered_buff_LENGTH)(aTHX_ (rx),(sv),(paren))
#define CALLREG_NAMED_BUFF_FETCH(rx, key, flags) \
- CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_FETCH))
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_FETCH))
#define CALLREG_NAMED_BUFF_STORE(rx, key, value, flags) \
- CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), (key), (value), ((flags) | RXapif_STORE))
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), (value), ((flags) | RXapif_STORE))
#define CALLREG_NAMED_BUFF_DELETE(rx, key, flags) \
- CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx),(key), NULL, ((flags) | RXapif_DELETE))
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx),(key), NULL, ((flags) | RXapif_DELETE))
#define CALLREG_NAMED_BUFF_CLEAR(rx, flags) \
- CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_CLEAR))
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_CLEAR))
#define CALLREG_NAMED_BUFF_EXISTS(rx, key, flags) \
- CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_EXISTS))
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_EXISTS))
#define CALLREG_NAMED_BUFF_FIRSTKEY(rx, flags) \
- CALL_FPTR((rx)->engine->named_buff_iter)(aTHX_ (rx), NULL, ((flags) | RXapif_FIRSTKEY))
+ CALL_FPTR(RX_ENGINE(rx)->named_buff_iter)(aTHX_ (rx), NULL, ((flags) | RXapif_FIRSTKEY))
#define CALLREG_NAMED_BUFF_NEXTKEY(rx, lastkey, flags) \
- CALL_FPTR((rx)->engine->named_buff_iter)(aTHX_ (rx), (lastkey), ((flags) | RXapif_NEXTKEY))
+ CALL_FPTR(RX_ENGINE(rx)->named_buff_iter)(aTHX_ (rx), (lastkey), ((flags) | RXapif_NEXTKEY))
#define CALLREG_NAMED_BUFF_SCALAR(rx, flags) \
- CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_SCALAR))
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_SCALAR))
#define CALLREG_NAMED_BUFF_COUNT(rx) \
- CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), NULL, NULL, RXapif_REGNAMES_COUNT)
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, RXapif_REGNAMES_COUNT)
#define CALLREG_NAMED_BUFF_ALL(rx, flags) \
- CALL_FPTR((rx)->engine->named_buff)(aTHX_ (rx), NULL, NULL, flags)
+ CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, flags)
#define CALLREG_PACKAGE(rx) \
- CALL_FPTR((rx)->engine->qr_package)(aTHX_ (rx))
+ CALL_FPTR(RX_ENGINE(rx)->qr_package)(aTHX_ (rx))
#if defined(USE_ITHREADS)
#define CALLREGDUPE(prog,param) \
Perl_re_dup(aTHX_ (prog),(param))
#define CALLREGDUPE_PVT(prog,param) \
- (prog ? CALL_FPTR((prog)->engine->dupe)(aTHX_ (prog),(param)) \
+ (prog ? CALL_FPTR(RX_ENGINE(prog)->dupe)(aTHX_ (prog),(param)) \
: (REGEXP *)NULL)
#endif
# 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
#endif
#if defined(HASVOLATILE) || defined(STANDARD_C)
-# ifdef __cplusplus
-# define VOL /* to temporarily suppress warnings */
-# else
# define VOL volatile
-# endif
#else
# define VOL
#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_ARENA_SIZE 4080
#endif
+/* Maximum level of recursion */
+#ifndef PERL_SUB_DEPTH_WARN
+#define PERL_SUB_DEPTH_WARN 100
+#endif
+
#endif /* PERL_CORE */
/* We no longer default to creating a new SV for GvSV.
#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
typedef struct av AV;
typedef struct hv HV;
typedef struct cv CV;
-typedef struct regexp REGEXP;
+typedef struct regexp ORANGE; /* This is the body structure. */
+typedef struct p5rx REGEXP;
typedef struct gp GP;
typedef struct gv GV;
typedef struct io IO;
# 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
+#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
-#include "regexp.h"
+/* 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 "form.h"
#include "gv.h"
#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_MASK 0x00FEEFFF /* 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_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_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_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_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)
#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_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",
- "LOOP",
- "SUBST",
+ "WHEN",
"BLOCK",
- "FORMAT",
"GIVEN",
- "WHEN"
+ "LOOP_FOR",
+ "LOOP_PLAIN",
+ "LOOP_LAZYSV",
+ "LOOP_LAZYIV",
+ "SUB",
+ "FORMAT",
+ "EVAL",
+ "SUBST"
};
#else
EXTCONST char* PL_block_type[];
#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 *);
#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,
MEMBER_TO_FPTR(Perl_magic_setisa),
0,
- MEMBER_TO_FPTR(Perl_magic_setisa),
+ MEMBER_TO_FPTR(Perl_magic_clearisa),
0,
0,
0,
MEMBER_TO_FPTR(Perl_magic_setregexp),
0,
0,
- MEMBER_TO_FPTR(Perl_magic_freeregexp),
+ 0,
0,
0,
0
#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