Fix a typo in #3725.
[p5sagit/p5-mst-13.2.git] / perl.h
diff --git a/perl.h b/perl.h
index 5d19c63..b8f9ae6 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -9,8 +9,6 @@
 #ifndef H_PERL
 #define H_PERL 1
 
-/*#define PERL_IMPLICIT_CONTEXT*/
-
 #ifdef PERL_FOR_X2P
 /*
  * This file is being used for x2p stuff. 
 
 /* XXXXXX testing threads via implicit pointer */
 #ifdef USE_THREADS
-#define PERL_IMPLICIT_CONTEXT
+#  ifndef PERL_IMPLICIT_CONTEXT
+#    define PERL_IMPLICIT_CONTEXT
+#  endif
+#  ifndef PERL_IMPLICIT_SYS
+/*#    define PERL_IMPLICIT_SYS*/              /* XXX not done yet */
+#  endif
+#endif
+
+/* XXXXXX testing multiplicity via implicit pointer */
+#if defined(MULTIPLICITY)
+#  ifndef PERL_IMPLICIT_CONTEXT
+#    define PERL_IMPLICIT_CONTEXT
+#  endif
+#  ifndef PERL_IMPLICIT_SYS
+/*#    define PERL_IMPLICIT_SYS*/              /* XXX not done yet */
+#  endif
+#endif
+
+#ifdef PERL_CAPI
+#  undef PERL_OBJECT
+#  ifndef PERL_IMPLICIT_CONTEXT
+#    define PERL_IMPLICIT_CONTEXT
+#  endif
+#  ifndef PERL_IMPLICIT_SYS
+#    define PERL_IMPLICIT_SYS
+#  endif
+#endif
+
+#ifdef PERL_OBJECT
+#  ifndef PERL_IMPLICIT_CONTEXT
+#    define PERL_IMPLICIT_CONTEXT
+#  endif
+#  ifndef PERL_IMPLICIT_SYS
+#    define PERL_IMPLICIT_SYS
+#  endif
 #endif
 
 #ifdef PERL_OBJECT
@@ -108,18 +140,20 @@ functions are now member functions of the PERL_OBJECT.
 class CPerlObj;
 
 #define STATIC
-#define CPERLscope(x) CPerlObj::x
-#define CALL_FPTR(fptr) (this->*fptr)
-
-#define pTHXo          CPerlObj *pPerl
-#define pTHXo_         pTHXo,
-#define _pTHXo         ,pTHXo
-#define aTHXo          this
-#define aTHXo_         this,
-#define _aTHXo         ,this
+#define CPERLscope(x)          CPerlObj::x
+#define CALL_FPTR(fptr)                (this->*fptr)
+
+#define pTHXo                  CPerlObj *pPerl
+#define pTHXo_                 pTHXo,
+#define _pTHXo                 ,pTHXo
+#define aTHXo                  this
+#define aTHXo_                 this,
+#define _aTHXo                 ,this
 #define PERL_OBJECT_THIS       aTHXo
 #define PERL_OBJECT_THIS_      aTHXo_
 #define _PERL_OBJECT_THIS      _aTHXo
+#define dTHXoa(a)              pTHXo = (CPerlObj *)a
+#define dTHXo                  dTHXoa(PERL_GET_INTERP)
 
 #define pTHXx          void
 #define pTHXx_
@@ -130,6 +164,27 @@ class CPerlObj;
 
 #else /* !PERL_OBJECT */
 
+#ifdef PERL_IMPLICIT_CONTEXT
+#  ifdef USE_THREADS
+struct perl_thread;
+#    define pTHX       register struct perl_thread *thr
+#    define aTHX       thr
+#    define dTHXa(a)   pTHX = (struct perl_thread *)a
+#    define dTHX       dTHXa(THR)
+#    define dTHR       dNOOP
+#  else
+#    define MULTIPLICITY
+#    define pTHX       register PerlInterpreter *my_perl
+#    define aTHX       my_perl
+#    define dTHXa(a)   pTHX = (PerlInterpreter *)a
+#    define dTHX       dTHXa(PERL_GET_INTERP)
+#  endif
+#  define pTHX_                pTHX,
+#  define _pTHX                ,pTHX
+#  define aTHX_                aTHX,
+#  define _aTHX                ,aTHX
+#endif
+
 #define STATIC static
 #define CPERLscope(x) x
 #define CPERLarg void
@@ -145,32 +200,14 @@ class CPerlObj;
 #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 CALLPROTECT CALL_FPTR(PL_protect)
 
 #define NOOP (void)0
 #define dNOOP extern int Perl___notused
 
-#ifdef PERL_IMPLICIT_CONTEXT
-#  ifdef USE_THREADS
-struct perl_thread;
-#    define pTHX       register struct perl_thread *thr
-#    define aTHX       thr
-#    define dTHXa(a)   pTHX = (struct perl_thread *)a
-#    define dTHX       dTHXa(SvPVX(PL_thrsv))
-#    define dTHR       dNOOP
-#  else
-#    define MULTIPLICITY
-#    define pTHX       register PerlInterpreter *my_perl
-#    define aTHX       my_perl
-#    define dTHXa(a)   pTHX = (PerlInterpreter *)a
-#    define dTHX       dTHXa(PL_curinterp)
-#  endif
-#  define pTHX_                pTHX,
-#  define _pTHX                ,pTHX
-#  define aTHX_                aTHX,
-#  define _aTHX                ,aTHX
-#endif
-
 #ifndef pTHX
 #  define pTHX         void
 #  define pTHX_
@@ -189,6 +226,7 @@ struct perl_thread;
 #  define aTHXo                aTHX
 #  define aTHXo_       aTHX_
 #  define _aTHXo       _aTHX
+#  define dTHXo                dTHX
 #endif
 
 #ifndef pTHXx
@@ -198,6 +236,7 @@ struct perl_thread;
 #  define aTHXx                my_perl
 #  define aTHXx_       aTHXx,
 #  define _aTHXx       ,aTHXx
+#  define dTHXx                dTHX
 #endif
 
 #undef START_EXTERN_C
@@ -281,7 +320,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
  */
 
 /* define this once if either system, instead of cluttering up the src */
-#if defined(MSDOS) || defined(atarist) || defined(WIN32) || defined(CYGWIN32)
+#if defined(MSDOS) || defined(atarist) || defined(WIN32)
 #define DOSISH 1
 #endif
 
@@ -445,6 +484,19 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 
 #define MEM_SIZE Size_t
 
+#if defined(STANDARD_C) && defined(I_STDDEF)
+#   include <stddef.h>
+#   define STRUCT_OFFSET(s,m)  offsetof(s,m)
+#else
+#   define STRUCT_OFFSET(s,m)  (Size_t)(&(((s *)0)->m))
+#endif
+
+#if defined(I_STRING) || defined(__cplusplus)
+#   include <string.h>
+#else
+#   include <strings.h>
+#endif
+
 /* This comes after <stdlib.h> so we don't try to change the standard
  * library prototypes; we'll use our own in proto.h instead. */
 
@@ -475,19 +527,6 @@ Free_t   Perl_mfree (Malloc_t where);
 #  define safefree    safesysfree
 #endif /* MYMALLOC */
 
-#if defined(STANDARD_C) && defined(I_STDDEF)
-#   include <stddef.h>
-#   define STRUCT_OFFSET(s,m)  offsetof(s,m)
-#else
-#   define STRUCT_OFFSET(s,m)  (Size_t)(&(((s *)0)->m))
-#endif
-
-#if defined(I_STRING) || defined(__cplusplus)
-#   include <string.h>
-#else
-#   include <strings.h>
-#endif
-
 #if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
 #define strchr index
 #define strrchr rindex
@@ -997,6 +1036,43 @@ Free_t   Perl_mfree (Malloc_t where);
 #  endif
 #endif
 
+#ifdef USE_LONG_DOUBLE
+#  if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)
+#    define LDoub_t long double
+#  endif
+#endif
+
+#ifdef USE_LONG_DOUBLE
+#   define HAS_LDOUB
+    typedef LDoub_t NV;
+#   define Perl_modf modfl
+#   define Perl_frexp frexpl
+#   define Perl_cos cosl
+#   define Perl_sin sinl
+#   define Perl_sqrt sqrtl
+#   define Perl_exp expl
+#   define Perl_log logl
+#   define Perl_atan2 atan2l
+#   define Perl_pow powl
+#   define Perl_floor floorl
+#   define Perl_atof atof
+#   define Perl_fmod fmodl
+#else
+    typedef double NV;
+#   define Perl_modf modf
+#   define Perl_frexp frexp
+#   define Perl_cos cos
+#   define Perl_sin sin
+#   define Perl_sqrt sqrt
+#   define Perl_exp exp
+#   define Perl_log log
+#   define Perl_atan2 atan2
+#   define Perl_pow pow
+#   define Perl_floor floor
+#   define Perl_atof atof              /* At some point there may be an atolf */
+#   define Perl_fmod fmod
+#endif
+
 /* Previously these definitions used hardcoded figures. 
  * It is hoped these formula are more portable, although
  * no data one way or another is presently known to me.
@@ -1198,7 +1274,6 @@ typedef struct unop UNOP;
 typedef struct binop BINOP;
 typedef struct listop LISTOP;
 typedef struct logop LOGOP;
-typedef struct condop CONDOP;
 typedef struct pmop PMOP;
 typedef struct svop SVOP;
 typedef struct gvop GVOP;
@@ -1419,10 +1494,6 @@ typedef union any ANY;
 #  endif
 #endif
 
-#ifndef FUNC_NAME_TO_PTR
-#define FUNC_NAME_TO_PTR(name)         name
-#endif
-
 /* 
  * USE_THREADS needs to be after unixish.h as <pthread.h> includes
  * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
@@ -1464,7 +1535,11 @@ typedef pthread_key_t    perl_key;
 #    endif /* WIN32 */
 #  endif /* FAKE_THREADS */
 #endif /* USE_THREADS */
-  
+
+#ifdef WIN32
+#include "win32.h"
+#endif
+
 #ifdef VMS
 #   define STATUS_NATIVE       PL_statusvalue_vms
 #   define STATUS_NATIVE_EXPORT \
@@ -1514,6 +1589,10 @@ typedef pthread_key_t    perl_key;
 #   define STATUS_ALL_FAILURE  (PL_statusvalue = 1)
 #endif
 
+#ifndef MEMBER_TO_FPTR
+#define MEMBER_TO_FPTR(name)           name
+#endif
+
 /* This defines a way to flush all output buffers.  This may be a
  * performance issue, so we allow people to disable it.
  * XXX the default needs a Configure test, as it may not work everywhere.
@@ -1525,11 +1604,19 @@ typedef pthread_key_t   perl_key;
 #  ifdef FFLUSH_ALL
 #   define PERL_FLUSHALL_FOR_CHILD     my_fflush_all()
 #  else
-#   define PERL_FLUSHALL_FOR_CHILD     (void)0
+#   define PERL_FLUSHALL_FOR_CHILD     NOOP
 #  endif
 # endif
 #endif
 
+#ifndef PERL_SET_INTERP
+#  define PERL_SET_INTERP(i)           (PL_curinterp = (PerlInterpreter*)(i))
+#endif
+
+#ifndef PERL_GET_INTERP
+#  define PERL_GET_INTERP              (PL_curinterp)
+#endif
+
 /* Some unistd.h's give a prototype for pause() even though
    HAS_PAUSE ends up undefined.  This causes the #define
    below to be rejected by the compmiler.  Sigh.
@@ -1570,7 +1657,7 @@ union any {
     I32                any_i32;
     IV         any_iv;
     long       any_long;
-    void       (CPERLscope(*any_dptr)) (pTHX_ void*);
+    void       (*any_dptr) (pTHXo_ void*);
 };
 #endif
 
@@ -1580,16 +1667,24 @@ union any {
 #define ARGSproto
 #endif /* USE_THREADS */
 
+#if defined(CYGWIN32)
+/* USEMYBINMODE
+ *   This symbol, if defined, indicates that the program should
+ *   use the routine my_binmode(FILE *fp, char iotype) to insure
+ *   that a file is in "binary" mode -- that is, that no translation
+ *   of bytes occurs on read or write operations.
+ */
+#define USEMYBINMODE / **/
+#define my_binmode(fp, iotype) \
+        (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : FALSE)
+#endif
+
 typedef I32 (*filter_t) (pTHXo_ int, SV *, int);
 
 #define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
 #define FILTER_DATA(idx)          (AvARRAY(PL_rsfp_filters)[idx])
 #define FILTER_ISREADER(idx)      (idx >= AvFILLp(PL_rsfp_filters))
 
-#ifdef WIN32
-#include "win32.h"
-#endif
-
 #include "iperlsys.h"
 #include "regexp.h"
 #include "sv.h"
@@ -1716,9 +1811,9 @@ typedef I32 CHECKPOINT;
 #define U_I(what) ((unsigned int)(what))
 #define U_L(what) ((U32)(what))
 #else
-#define U_S(what) ((U16)cast_ulong((double)(what)))
-#define U_I(what) ((unsigned int)cast_ulong((double)(what)))
-#define U_L(what) (cast_ulong((double)(what)))
+#define U_S(what) ((U16)cast_ulong((NV)(what)))
+#define U_I(what) ((unsigned int)cast_ulong((NV)(what)))
+#define U_L(what) (cast_ulong((NV)(what)))
 #endif
 
 #ifdef CASTI32
@@ -1726,9 +1821,9 @@ typedef I32 CHECKPOINT;
 #define I_V(what) ((IV)(what))
 #define U_V(what) ((UV)(what))
 #else
-#define I_32(what) (cast_i32((double)(what)))
-#define I_V(what) (cast_iv((double)(what)))
-#define U_V(what) (cast_uv((double)(what)))
+#define I_32(what) (cast_i32((NV)(what)))
+#define I_V(what) (cast_iv((NV)(what)))
+#define U_V(what) (cast_uv((NV)(what)))
 #endif
 
 /* Used with UV/IV arguments: */
@@ -1776,7 +1871,7 @@ Gid_t getegid (void);
 #  if defined(PERL_OBJECT)
 #    define DEBUG_m(a) if (PL_debug & 128)     a
 #  else
-#    define DEBUG_m(a) if (PL_curinterp && PL_debug & 128)     a
+#    define DEBUG_m(a) if (PERL_GET_INTERP && PL_debug & 128)  a
 #  endif
 #define DEBUG_f(a) if (PL_debug & 256) a
 #define DEBUG_r(a) if (PL_debug & 512) a
@@ -2327,8 +2422,8 @@ enum {            /* pass one of these to get_vtbl */
 
 /* Various states of an input record separator SV (rs, nrs) */
 #define RsSNARF(sv)   (! SvOK(sv))
-#define RsSIMPLE(sv)  (SvOK(sv) && SvCUR(sv))
-#define RsPARA(sv)    (SvOK(sv) && ! SvCUR(sv))
+#define RsSIMPLE(sv)  (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))
+#define RsPARA(sv)    (SvPOK(sv) && ! SvCUR(sv))
 #define RsRECORD(sv)  (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
 
 /* Enable variables which are pointers to functions */
@@ -2336,10 +2431,27 @@ typedef regexp*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm);
 typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg,
                                      char* strend, char* strbeg, I32 minend,
                                      SV* screamer, void* data, U32 flags);
+typedef char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv,
+                                               char *strpos, char *strend,
+                                               U32 flags,
+                                               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);
 
+#ifdef USE_PURE_BISON
+int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp);
+#endif
+
+typedef void (*DESTRUCTORFUNC_t) (pTHXo_ void*);
+typedef void (*SVFUNC_t) (pTHXo_ SV*);
+typedef I32  (*SVCOMPARE_t) (pTHXo_ SV*, SV*);
+typedef void (*XSINIT_t) (pTHXo);
+typedef void (*ATEXIT_t) (pTHXo_ void*);
+typedef void (*XSUBADDR_t) (pTHXo_ CV *);
 
 /* Set up PERLVAR macros for populating structs */
 #define PERLVAR(var,type) type var;
+#define PERLVARA(var,n,type) type var[n];
 #define PERLVARI(var,type,init) type var;
 #define PERLVARIC(var,type,init) type var;
 
@@ -2421,6 +2533,7 @@ typedef void *Thread;
 
 /* Done with PERLVAR macros for now ... */
 #undef PERLVAR
+#undef PERLVARA
 #undef PERLVARI
 #undef PERLVARIC
 
@@ -2447,17 +2560,6 @@ typedef void *Thread;
 #  endif
 #endif
 
-#ifdef USE_PURE_BISON
-int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp);
-#endif
-
-typedef void (CPERLscope(*DESTRUCTORFUNC_t)) (pTHX_ void*);
-typedef void (CPERLscope(*SVFUNC_t)) (pTHX_ SV*);
-typedef I32 (CPERLscope(*SVCOMPARE_t)) (pTHX_ SV*, SV*);
-typedef void (*XSINIT_t) (pTHXo);
-typedef void (*ATEXIT_t) (pTHXo_ void*);
-typedef void (*XSUBADDR_t) (pTHXo_ CV *);
-
 #ifdef PERL_OBJECT
 #define PERL_DECL_PROT
 #define perl_alloc Perl_alloc
@@ -2476,7 +2578,6 @@ public:
 #include "pp_proto.h"
 
 #ifdef PERL_OBJECT
-VIRTUAL int CPerlObj::fprintf (PerlIO *pf, const char *pat, ...);
 VIRTUAL int CPerlObj::do_aspawn (void *vreally, void **vmark, void **vsp);
 #undef PERL_DECL_PROT
 #else
@@ -2500,21 +2601,10 @@ VIRTUAL int CPerlObj::do_aspawn (void *vreally, void **vmark, void **vsp);
  */
                          
 #define PERLVAR(var,type) EXT type PL_##var;
+#define PERLVARA(var,n,type) EXT type PL_##var[n];
 #define PERLVARI(var,type,init) EXT type  PL_##var INIT(init);
 #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
 
-#ifndef PERL_GLOBAL_STRUCT
-#  ifndef PERL_OBJECT
-START_EXTERN_C
-#  endif
-
-#  include "perlvars.h"
-
-#  ifndef PERL_OBJECT
-END_EXTERN_C
-#  endif
-#endif
-
 #ifndef MULTIPLICITY
 
 #  include "intrpvar.h"
@@ -2530,9 +2620,10 @@ END_EXTERN_C
  * be defined to maintain binary compatibility with PERL_OBJECT
  * for 5.005
  */
-PERLVAR(object_compatibility[30],      char)
+PERLVARA(object_compatibility,30,      char)
 };
 
+
 #  include "embed.h"
 #  if defined(WIN32) && !defined(WIN32IO_IS_STDIO)
 #    define errno      CPerlObj::ErrorNo()
@@ -2549,7 +2640,16 @@ PERLVAR(object_compatibility[30],        char)
 
 #endif  /* PERL_OBJECT */
 
+#ifndef PERL_GLOBAL_STRUCT
+START_EXTERN_C
+
+#  include "perlvars.h"
+
+END_EXTERN_C
+#endif
+
 #undef PERLVAR
+#undef PERLVARA
 #undef PERLVARI
 #undef PERLVARIC
 
@@ -2858,7 +2958,7 @@ typedef struct am_table_short AMTS;
 
 #define RESTORE_NUMERIC_LOCAL()                if ((PL_hints & HINT_LOCALE) && PL_numeric_standard) SET_NUMERIC_LOCAL()
 #define RESTORE_NUMERIC_STANDARD()     if ((PL_hints & HINT_LOCALE) && PL_numeric_local) SET_NUMERIC_STANDARD()
-#define Atof(s)                                Perl_my_atof(s)
+#define Atof                           my_atof
 
 #else /* !USE_LOCALE_NUMERIC */
 
@@ -2867,7 +2967,7 @@ typedef struct am_table_short AMTS;
 #define IS_NUMERIC_RADIX(c)            (0)
 #define RESTORE_NUMERIC_LOCAL()                /**/
 #define RESTORE_NUMERIC_STANDARD()     /**/
-#define Atof(s)                                atof(s)
+#define Atof                           Perl_atof
 
 #endif /* !USE_LOCALE_NUMERIC */