/* 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 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 */
#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
/* 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
#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 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;
# 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)
};
#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"
#include "warnings.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
typedef struct _sublex_info SUBLEXINFO;
struct _sublex_info {
#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);
#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[];
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 *);
0,
MEMBER_TO_FPTR(Perl_magic_setisa),
0,
- MEMBER_TO_FPTR(Perl_magic_setisa),
+ MEMBER_TO_FPTR(Perl_magic_clearisa),
0,
0,
0,
MGVTBL_SET(
PL_vtbl_bm,
0,
- MEMBER_TO_FPTR(Perl_magic_setbm),
+ MEMBER_TO_FPTR(Perl_magic_setregexp),
0,
0,
0,
MGVTBL_SET(
PL_vtbl_fm,
0,
- MEMBER_TO_FPTR(Perl_magic_setfm),
+ MEMBER_TO_FPTR(Perl_magic_setregexp),
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 )
+ PERLDBf_NAMEEVAL| PERLDBf_NAMEANON | \
+ PERLDBf_SAVESRC)
/* No _NONAME, _GOTO, _ASSERTION */
#define PERLDBf_SUB 0x01 /* Debug sub enter/exit */
#define PERLDBf_LINE 0x02 /* Keep line # */
#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 PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB))
#define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE))
#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))
#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 /* 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
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
https://perl5.git.perl.org / perl5.git / blobdiff