#define CALL_FPTR(fptr) (*fptr)
#define CALLRUNOPS CALL_FPTR(PL_runops)
-#define CALLREGCOMP CALL_FPTR(PL_regcompp)
-#define CALLREGEXEC CALL_FPTR(PL_regexecp)
-#define CALLREG_INTUIT_START CALL_FPTR(PL_regint_start)
-#define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
-#define CALLREGFREE CALL_FPTR(PL_regfree)
+
+#define CALLREGCOMP(exp, xend, pm) Perl_pregcomp(aTHX_ exp,xend,pm)
+
+#define CALLREGCOMP_ENG(prog, exp, xend, pm) \
+ CALL_FPTR(((prog)->comp))(aTHX_ exp, xend, pm)
+#define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,screamer,data,flags) \
+ CALL_FPTR((prog)->engine->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), \
+ (strend),(flags),(data))
+#define CALLREG_INTUIT_STRING(prog) \
+ CALL_FPTR((prog)->engine->checkstr)(aTHX_ (prog))
+#define CALLREGFREE(prog) \
+ if(prog) CALL_FPTR((prog)->engine->free)(aTHX_ (prog))
+#if defined(USE_ITHREADS)
+#define CALLREGDUPE(prog,param) \
+ (prog ? CALL_FPTR((prog)->engine->dupe)(aTHX_ (prog),(param)) \
+ : (REGEXP *)NULL)
+#endif
/*
* Because of backward compatibility reasons the PERL_UNUSED_DECL
#endif
#define NOOP /*EMPTY*/(void)0
+#if !defined(HASATTRIBUTE_UNUSED) && defined(__cplusplus)
+#define dNOOP /*EMPTY*/(void)0 /* Older g++ has no __attribute((unused))__ */
+#else
#define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
+#endif
#ifndef pTHX
/* Don't bother defining tTHX and sTHX; using them outside
* PERL_CALLCONV to be something special. See also the
* definition of XS() in XSUB.h. */
#ifndef PERL_EXPORT_C
-# define PERL_EXPORT_C extern
+# ifdef __cplusplus
+# define PERL_EXPORT_C extern "C"
+# else
+# define PERL_EXPORT_C extern
+# endif
#endif
#ifndef PERL_XS_EXPORT_C
-# define PERL_XS_EXPORT_C
+# ifdef __cplusplus
+# define PERL_XS_EXPORT_C extern "C"
+# else
+# define PERL_XS_EXPORT_C
+# endif
#endif
#ifdef OP_IN_REGISTER
# endif
#endif
-#if defined(PERL_GCC_PEDANTIC)
+/* gcc (-ansi) -pedantic doesn't allow gcc brace groups,
+ * g++ allows them but seems to have problems with them
+ * (insane errors ensue). */
+#if defined(PERL_GCC_PEDANTIC) || (defined(__GNUC__) && defined(__cplusplus))
# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
# endif
#endif
#if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) && !defined(PERL_MICRO)
-int syscall(int, ...);
+EXTERN_C int syscall(int, ...);
#endif
#if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO) && !defined(PERL_MICRO)
-int usleep(unsigned int);
+EXTERN_C int usleep(unsigned int);
#endif
#ifdef PERL_MICRO /* Last chance to export Perl_my_swap */
# endif
#endif
+#if defined(__osf__) && defined(__cplusplus) && !defined(_XOPEN_SOURCE_EXTENDED) /* Tru64 "cxx" (C++), see hints/dec_osf.sh for why the _XOPEN_SOURCE_EXTENDED cannot be defined. */
+EXTERN_C int fchdir(int);
+EXTERN_C int flock(int, int);
+EXTERN_C int fseeko(FILE *, off_t, int);
+EXTERN_C off_t ftello(FILE *);
+#endif
+
+#if defined(__SUNPRO_CC) /* SUNWspro CC (C++) */
+EXTERN_C char *crypt(const char *, const char *);
+EXTERN_C char **environ;
+#endif
+
#ifdef SETERRNO
# undef SETERRNO /* SOCKS might have defined this */
#endif
* that should be true only if the snprintf()/vsnprintf() are true
* to the standard. */
-#if defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS))
+#if defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define my_snprintf(buffer, len, ...) ({ int __len__ = snprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak(aTHX_ "panic: snprintf buffer overflow"); __len__; })
+# define my_snprintf(buffer, len, ...) ({ int __len__ = snprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak_nocontext("panic: snprintf buffer overflow"); __len__; })
# define PERL_MY_SNPRINTF_GUARDED
# else
# define my_snprintf(buffer, len, ...) snprintf(buffer, len, __VA_ARGS__)
# define PERL_MY_SNPRINTF_GUARDED
#endif
-#if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS))
+#if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define my_vsnprintf(buffer, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak(aTHX_ "panic: vsnprintf buffer overflow"); __len__; })
+# define my_vsnprintf(buffer, len, ...) ({ int __len__ = vsnprintf(buffer, len, __VA_ARGS__); if ((len) > 0 && (Size_t)__len__ >= (len)) Perl_croak_nocontext("panic: vsnprintf buffer overflow"); __len__; })
# define PERL_MY_VSNPRINTF_GUARDED
# else
# define my_vsnprintf(buffer, len, ...) vsnprintf(buffer, len, __VA_ARGS__)
# define PERL_MY_VSNPRINTF_GUARDED
#endif
+#ifdef HAS_STRLCAT
+# define my_strlcat strlcat
+#else
+# define my_strlcat Perl_my_strlcat
+#endif
+
+#ifdef HAS_STRLCPY
+# define my_strlcpy strlcpy
+#else
+# define my_strlcpy Perl_my_strlcpy
+#endif
+
/* Configure gets this right but the UTS compiler gets it wrong.
-- Hal Morris <hom00@utsglobal.com> */
#ifdef UTS
# define HASATTRIBUTE_PURE
# endif
# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
- /* This actually works for gcc-3.3, but not for g++-3.3. */
# define HASATTRIBUTE_UNUSED
# endif
+# if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus)
+# define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */
+# endif
# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
# define HASATTRIBUTE_WARN_UNUSED_RESULT
# endif
# endif
#endif
+/* not used; but needed for backward compatibilty with XS code? - RMB */
#ifndef UVf
# define UVf UVuf
#endif
#define DEBUG_r_FLAG 0x00000200 /* 512 */
#define DEBUG_x_FLAG 0x00000400 /* 1024 */
#define DEBUG_u_FLAG 0x00000800 /* 2048 */
- /* spare */
+/* U is reserved for Unofficial, exploratory hacking */
+#define DEBUG_U_FLAG 0x00001000 /* 4096 */
#define DEBUG_H_FLAG 0x00002000 /* 8192 */
#define DEBUG_X_FLAG 0x00004000 /* 16384 */
#define DEBUG_D_FLAG 0x00008000 /* 32768 */
# define DEBUG_r_TEST_ (PL_debug & DEBUG_r_FLAG)
# define DEBUG_x_TEST_ (PL_debug & DEBUG_x_FLAG)
# define DEBUG_u_TEST_ (PL_debug & DEBUG_u_FLAG)
+# define DEBUG_U_TEST_ (PL_debug & DEBUG_U_FLAG)
# 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_r_TEST DEBUG_r_TEST_
# define DEBUG_x_TEST DEBUG_x_TEST_
# define DEBUG_u_TEST DEBUG_u_TEST_
+# define DEBUG_U_TEST DEBUG_U_TEST_
# define DEBUG_H_TEST DEBUG_H_TEST_
# define DEBUG_X_TEST DEBUG_X_TEST_
# define DEBUG_Xv_TEST DEBUG_Xv_TEST_
} STMT_END
# define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a)
+#ifndef PERL_EXT_RE_BUILD
# define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
+#else
+# define DEBUG_r(a) STMT_START {a;} STMT_END
+#endif /* PERL_EXT_RE_BUILD */
# define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a)
# define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
+# define DEBUG_U(a) DEBUG__(DEBUG_U_TEST, a)
# define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a)
# define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a)
# define DEBUG_Xv(a) DEBUG__(DEBUG_Xv_TEST, a)
# define DEBUG_r_TEST (0)
# define DEBUG_x_TEST (0)
# define DEBUG_u_TEST (0)
+# define DEBUG_U_TEST (0)
# define DEBUG_H_TEST (0)
# define DEBUG_X_TEST (0)
# define DEBUG_Xv_TEST (0)
# define DEBUG_r(a)
# define DEBUG_x(a)
# define DEBUG_u(a)
+# define DEBUG_U(a)
# define DEBUG_H(a)
# define DEBUG_X(a)
# define DEBUG_Xv(a)
#define PERL_MAGIC_overload_elem 'a' /* %OVERLOAD hash element */
#define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash */
#define PERL_MAGIC_bm 'B' /* Boyer-Moore (fast string search) */
+#define PERL_MAGIC_regdata_names '+' /* Regex named capture buffer hash
+ (%+ support) */
#define PERL_MAGIC_regdata 'D' /* Regex match position data
(@+ and @- vars) */
#define PERL_MAGIC_regdatum 'd' /* Regex match position data element */
# define RUNOPS_DEFAULT Perl_runops_standard
#endif
+#ifdef USE_PERLIO
+EXTERN_C void PerlIO_teardown(pTHX);
+# ifdef USE_ITHREADS
+# define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex)
+# define PERLIO_TERM \
+ STMT_START { \
+ PerlIO_teardown(aTHX); \
+ MUTEX_DESTROY(&PL_perlio_mutex);\
+ } STMT_END
+# else
+# define PERLIO_INIT
+# define PERLIO_TERM PerlIO_teardown(aTHX)
+# endif
+#else
+# define PERLIO_INIT
+# define PERLIO_TERM
+#endif
+
#ifdef MYMALLOC
# ifdef MUTEX_INIT_CALLS_MALLOC
# define MALLOC_INIT \
EXTCONST char PL_no_aelem[]
INIT("Modification of non-creatable array value attempted, subscript %d");
EXTCONST char PL_no_helem_sv[]
- INIT("Modification of non-creatable hash value attempted, subscript \""SVf"\"");
+ INIT("Modification of non-creatable hash value attempted, subscript \"%"SVf"\"");
EXTCONST char PL_no_modify[]
INIT("Modification of a read-only value attempted");
EXTCONST char PL_no_mem[]
#define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */
#define HINT_UTF8 0x00800000 /* utf8 pragma */
-/* assertions pragma */
-#define HINT_ASSERTING 0x01000000
-#define HINT_ASSERTIONSSEEN 0x02000000
+/* assertions pragma, stored in $^H{assertions} */
+#define HINT_ASSERTING 0x00000001
+#define HINT_ASSERTIONSSEEN 0x00000002
/* The following are stored in $^H{sort}, not in PL_hints */
#define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */
struct re_scream_pos_data_s *d);
typedef SV* (CPERLscope(*re_intuit_string_t)) (pTHX_ regexp *prog);
typedef void (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r);
+typedef regexp*(CPERLscope(*regdupe_t)) (pTHX_ const regexp* r, CLONE_PARAMS *param);
typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*);
typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*);
#include "pp.h"
#ifndef PERL_CALLCONV
-# define PERL_CALLCONV
+# ifdef __cplusplus
+# define PERL_CALLCONV extern "C"
+# else
+# define PERL_CALLCONV
+# endif
#endif
#undef PERL_CKDEF
#undef PERL_PPDEF
START_EXTERN_C
+/* PERL_GLOBAL_STRUCT_PRIVATE wants to keep global data like the
+ * magic vtables const, but this is incompatible with SWIG which
+ * does want to modify the vtables. */
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+# define EXT_MGVTBL EXTCONST MGVTBL
+#else
+# define EXT_MGVTBL EXT MGVTBL
+#endif
+
#ifdef DOINIT
-# define MGVTBL_SET(var,a,b,c,d,e,f,g,h) EXT MGVTBL var = {a,b,c,d,e,f,g,h}
+# define MGVTBL_SET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var = {a,b,c,d,e,f,g,h}
/* Like MGVTBL_SET but with the get magic having a const MG* */
-# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g,h) EXT MGVTBL var \
+# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var \
= {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g,h}
#else
-# define MGVTBL_SET(var,a,b,c,d,e,f,g,h) EXT MGVTBL var
-# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g,h) EXT MGVTBL var
+# define MGVTBL_SET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var
+# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g,h) EXT_MGVTBL var
#endif
MGVTBL_SET(
);
MGVTBL_SET(
+ PL_vtbl_regdata_names,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL
+);
+
+MGVTBL_SET(
PL_vtbl_regdata,
NULL,
NULL,
NULL
);
-
-enum {
- fallback_amg, abs_amg,
- bool__amg, nomethod_amg,
- string_amg, numer_amg,
- add_amg, add_ass_amg,
- subtr_amg, subtr_ass_amg,
- mult_amg, mult_ass_amg,
- div_amg, div_ass_amg,
- modulo_amg, modulo_ass_amg,
- pow_amg, pow_ass_amg,
- lshift_amg, lshift_ass_amg,
- rshift_amg, rshift_ass_amg,
- band_amg, band_ass_amg,
- bor_amg, bor_ass_amg,
- bxor_amg, bxor_ass_amg,
- lt_amg, le_amg,
- gt_amg, ge_amg,
- eq_amg, ne_amg,
- ncmp_amg, scmp_amg,
- slt_amg, sle_amg,
- sgt_amg, sge_amg,
- seq_amg, sne_amg,
- not_amg, compl_amg,
- inc_amg, dec_amg,
- atan2_amg, cos_amg,
- sin_amg, exp_amg,
- log_amg, sqrt_amg,
- repeat_amg, repeat_ass_amg,
- concat_amg, concat_ass_amg,
- copy_amg, neg_amg,
- to_sv_amg, to_av_amg,
- to_hv_amg, to_gv_amg,
- to_cv_amg, iter_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. */
-};
-
-#define NofAMmeth max_amg_code
-#define AMG_id2name(id) (PL_AMG_names[id]+1)
-
-#ifdef DOINIT
-EXTCONST char * const PL_AMG_names[NofAMmeth] = {
- /* Names kept in the symbol table. fallback => "()", the rest has
- "(" prepended. The only other place in perl which knows about
- this convention is AMG_id2name (used for debugging output and
- 'nomethod' only), the only other place which has it hardwired is
- overload.pm. */
- "()", "(abs", /* "fallback" should be the first. */
- "(bool", "(nomethod",
- "(\"\"", "(0+",
- "(+", "(+=",
- "(-", "(-=",
- "(*", "(*=",
- "(/", "(/=",
- "(%", "(%=",
- "(**", "(**=",
- "(<<", "(<<=",
- "(>>", "(>>=",
- "(&", "(&=",
- "(|", "(|=",
- "(^", "(^=",
- "(<", "(<=",
- "(>", "(>=",
- "(==", "(!=",
- "(<=>", "(cmp",
- "(lt", "(le",
- "(gt", "(ge",
- "(eq", "(ne",
- "(!", "(~",
- "(++", "(--",
- "(atan2", "(cos",
- "(sin", "(exp",
- "(log", "(sqrt",
- "(x", "(x=",
- "(.", "(.=",
- "(=", "(neg",
- "(${}", "(@{}",
- "(%{}", "(*{}",
- "(&{}", "(<>",
- "(int", "(~~",
- "DESTROY"
-};
-#else
-EXTCONST char * PL_AMG_names[NofAMmeth];
-#endif /* def INITAMAGIC */
+#include "overload.h"
END_EXTERN_C
struct am_table {
+ U32 flags;
U32 was_ok_sub;
long was_ok_am;
- U32 flags;
CV* table[NofAMmeth];
long fallback;
};
struct am_table_short {
+ U32 flags;
U32 was_ok_sub;
long was_ok_am;
- U32 flags;
};
typedef struct am_table AMT;
typedef struct am_table_short AMTS;
# define do_aexec(really, mark,sp) do_aexec5(really, mark, sp, 0, 0)
#endif
+#if defined(OEMVS)
+#define NO_ENV_ARRAY_IN_MAIN
+#endif
+
/* and finally... */
#define PERL_PATCHLEVEL_H_IMPLICIT
#include "patchlevel.h"
#undef PERL_PATCHLEVEL_H_IMPLICIT
-/* Mention
+/* These are used by Perl_pv_escape() and Perl_pv_pretty()
+ * are here so that they are available throughout the core
+ * NOTE that even though some are for _escape and some for _pretty
+ * there must not be any clashes as the flags from _pretty are
+ * passed straight through to _escape.
+ */
+
+#define PERL_PV_ESCAPE_QUOTE 0x0001
+#define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
+
+
+#define PERL_PV_PRETTY_ELIPSES 0x0002
+#define PERL_PV_PRETTY_LTGT 0x0004
+
+#define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
+
+#define PERL_PV_ESCAPE_UNI 0x0100
+#define PERL_PV_ESCAPE_UNI_DETECT 0x0200
+
+#define PERL_PV_ESCAPE_ALL 0x1000
+#define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
+#define PERL_PV_ESCAPE_NOCLEAR 0x4000
+
+/* used by pv_display in dump.c*/
+#define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_QUOTE
+#define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELIPSES|PERL_PV_PRETTY_LTGT
+
+/*
+
+ (KEEP THIS LAST IN perl.h!)
+
+ Mention
NV_PRESERVES_UV
HAS_DIRFD
- so that Configure picks them up. */
+ so that Configure picks them up.
-/* these are used by Perl_pv_escape() and are here so that they
- * are available throughout the core */
+ (KEEP THIS LAST IN perl.h!)
-#define PERL_PV_ESCAPE_QUOTE 1
-#define PERL_PV_ESCAPE_PADR 2
-#define PERL_PV_ESCAPE_CAT 4
+*/
#endif /* Include guard */
https://perl5.git.perl.org / perl5.git / blobdiff