This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add PERLIO_INIT to PERL_SYS_INIT.
[perl5.git] / perl.h
diff --git a/perl.h b/perl.h
index 81cf565..b23439f 100644 (file)
--- a/perl.h
+++ b/perl.h
 #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 CALLREGDUPE CALL_FPTR(PL_regdupe)
+
+#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
@@ -1494,7 +1508,7 @@ EXTERN_C char **environ;
 
 #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__)
@@ -1506,7 +1520,7 @@ EXTERN_C char **environ;
 
 #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__)
@@ -3406,7 +3420,8 @@ Gid_t getegid (void);
 #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 */
@@ -3436,6 +3451,7 @@ Gid_t getegid (void);
 #  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)
@@ -3463,6 +3479,7 @@ Gid_t getegid (void);
 #  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_
@@ -3499,9 +3516,14 @@ Gid_t getegid (void);
        } 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)
@@ -3530,6 +3552,7 @@ Gid_t getegid (void);
 #  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)
@@ -3557,6 +3580,7 @@ Gid_t getegid (void);
 #  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)
@@ -3591,6 +3615,8 @@ Gid_t getegid (void);
 #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 */
@@ -3837,6 +3863,24 @@ typedef Sighandler_t Sigsave_t;
 # 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                                        \
@@ -3943,7 +3987,7 @@ EXTCONST char PL_no_usym[]
 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[]
@@ -4806,6 +4850,18 @@ MGVTBL_SET(
 );
 
 MGVTBL_SET(
+    PL_vtbl_regdata_names,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL
+);
+
+MGVTBL_SET(
     PL_vtbl_regdata,
     NULL,
     NULL,
@@ -4914,110 +4970,21 @@ MGVTBL_SET(
     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;