Put back the cygwin32 Configure fix of 3582 undone by 3597.
[p5sagit/p5-mst-13.2.git] / perl.h
diff --git a/perl.h b/perl.h
index 73f1dc6..558d423 100644 (file)
--- a/perl.h
+++ b/perl.h
 #define USE_STDIO
 #endif /* PERL_FOR_X2P */
 
+#define VOIDUSED 1
+#include "config.h"
+
+/* XXXXXX testing threads via implicit pointer */
+#ifdef USE_THREADS
+#define PERL_IMPLICIT_CONTEXT
+#endif
+
 #ifdef PERL_OBJECT
 
 /* PERL_OBJECT explained  - DickH and DougL @ ActiveState.com
@@ -101,22 +109,29 @@ class CPerlObj;
 
 #define STATIC
 #define CPERLscope(x) CPerlObj::x
-#define CPERLproto CPerlObj *
-#define _CPERLproto ,CPERLproto
-#define CPERLarg CPerlObj *pPerl
-#define CPERLarg_ CPERLarg,
-#define _CPERLarg ,CPERLarg
-#define PERL_OBJECT_THIS this
-#define _PERL_OBJECT_THIS ,this
-#define PERL_OBJECT_THIS_ this,
 #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 pTHXx          void
+#define pTHXx_
+#define _pTHXx
+#define aTHXx
+#define aTHXx_
+#define _aTHXx
+
 #else /* !PERL_OBJECT */
 
 #define STATIC static
 #define CPERLscope(x) x
-#define CPERLproto
-#define _CPERLproto
 #define CPERLarg void
 #define CPERLarg_
 #define _CPERLarg
@@ -132,12 +147,57 @@ class CPerlObj;
 #define CALLREGEXEC CALL_FPTR(PL_regexecp)
 #define CALLPROTECT CALL_FPTR(PL_protect)
 
-#define VOIDUSED 1
-#include "config.h"
+#define NOOP (void)0
+#define dNOOP extern int Perl___notused
 
-/* XXXXXX testing threads via implicit pointer */
-#ifdef USE_THREADS
-#define PERL_IMPLICIT_CONTEXT
+#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_
+#  define _pTHX
+#  define aTHX
+#  define aTHX_
+#  define _aTHX
+#  define dTHXa(a)     dNOOP
+#  define dTHX         dNOOP
+#endif
+
+#ifndef pTHXo
+#  define pTHXo                pTHX
+#  define pTHXo_       pTHX_
+#  define _pTHXo       _pTHX
+#  define aTHXo                aTHX
+#  define aTHXo_       aTHX_
+#  define _aTHXo       _aTHX
+#endif
+
+#ifndef pTHXx
+#  define pTHXx                register PerlInterpreter *my_perl
+#  define pTHXx_       pTHXx,
+#  define _pTHXx       ,pTHXx
+#  define aTHXx                my_perl
+#  define aTHXx_       aTHXx,
+#  define _aTHXx       ,aTHXx
 #endif
 
 #undef START_EXTERN_C
@@ -150,7 +210,7 @@ class CPerlObj;
 #else
 #  define START_EXTERN_C 
 #  define END_EXTERN_C 
-#  define EXTERN_C
+#  define EXTERN_C extern
 #endif
 
 #ifdef OP_IN_REGISTER
@@ -184,8 +244,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 # endif
 #endif
 
-#define NOOP (void)0
-#define dNOOP extern int Perl___notused
+#define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
 #define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
 
 /*
@@ -222,15 +281,15 @@ 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
 
-#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
+#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC)
 # define STANDARD_C 1
 #endif
 
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC)
 # define DONT_DECLARE_STD 1
 #endif
 
@@ -327,8 +386,6 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #  endif
 #endif
 
-#include "iperlsys.h"
-
 #ifdef USE_NEXT_CTYPE
 
 #if NX_CURRENT_COMPILER_RELEASE >= 500
@@ -382,7 +439,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #   include <stdlib.h>
 #endif
 
-#if !defined(PERL_FOR_X2P)
+#if !defined(PERL_FOR_X2P) && !defined(PERL_OBJECT)
 #  include "embed.h"
 #endif
 
@@ -1329,7 +1386,11 @@ typedef union any ANY;
 #       if defined(__VOS__)
 #         include "vosish.h"
 #       else
-#         include "unixish.h"
+#         if defined(EPOC)
+#           include "epocish.h"
+#         else
+#           include "unixish.h"
+#         endif
 #       endif
 #     endif
 #   endif
@@ -1501,45 +1562,6 @@ typedef pthread_key_t    perl_key;
             (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : NULL)
 #endif
 
-#ifdef PERL_IMPLICIT_CONTEXT
-#  ifdef USE_THREADS
-struct perl_thread;
-#    define pTHX struct perl_thread *thr
-#    define pTHX_ pTHX,
-#    define _pTHX ,pTHX
-#    define aTHX thr
-#    define aTHX_ aTHX,
-#    define _aTHX ,aTHX
-#    define dTHX pTHX = (struct perl_thread *)SvPVX(PL_thrsv)
-#    define dTHR dNOOP
-#  else
-#    define MULTIPLICITY
-#    define pTHX PerlInterpreter *my_perl
-#    define pTHX_ pTHX,
-#    define _pTHX ,pTHX
-#    define aTHX my_perl
-#    define aTHX_ aTHX,
-#    define _aTHX ,aTHX
-#    define dTHX pTHX = PL_curinterp
-#  endif
-#endif
-
-#ifndef pTHX
-#  define pTHX void
-#  define pTHX_
-#  define _pTHX
-#  define aTHX
-#  define aTHX_
-#  define _aTHX
-#  define dTHX dNOOP
-#endif
-
-#define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
-
-#ifndef STATIC
-#  define STATIC static
-#endif
-
 #ifdef UNION_ANY_DEFINITION
 UNION_ANY_DEFINITION;
 #else
@@ -1558,25 +1580,35 @@ union any {
 #define ARGSproto
 #endif /* USE_THREADS */
 
-#ifdef PERL_OBJECT
-typedef I32 (*filter_t) (CPerlObj*, int, SV *, int);
-#else
-typedef I32 (*filter_t) (pTHX_ int, SV *, int);
+#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"
 #include "util.h"
 #include "form.h"
 #include "gv.h"
 #include "cv.h"
-#ifndef PERL_OBJECT
-#include "opcode.h"
-#endif
 #include "op.h"
 #include "cop.h"
 #include "av.h"
@@ -1753,7 +1785,7 @@ Gid_t getegid (void);
 #define DEBUG_o(a) if (PL_debug & 16)  a
 #define DEBUG_c(a) if (PL_debug & 32)  a
 #define DEBUG_P(a) if (PL_debug & 64)  a
-#  if defined(PERL_OBJECT) || defined(PERL_IMPLICIT_CONTEXT)
+#  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
@@ -1859,7 +1891,9 @@ char *crypt (const char*, const char*);
 #    ifndef getenv
 char *getenv (const char*);
 #    endif /* !getenv */
+#ifndef EPOC
 Off_t lseek (int,Off_t,int);
+#endif
 #  endif /* !DONT_DECLARE_STD */
 char *getlogin (void);
 #endif /* !__cplusplus */
@@ -1930,18 +1964,8 @@ typedef Sighandler_t Sigsave_t;
 #endif
 
 
-/*
- * These need prototyping here because <proto.h> isn't
- * included until after runops is initialised.
- */
-
-#ifndef PERL_OBJECT
-typedef int (*runops_proc_t) (pTHX);
-int Perl_runops_standard (pTHX);
-#ifdef DEBUGGING
-int Perl_runops_debug (pTHX);
-#endif
-#endif
+typedef int (CPERLscope(*runops_proc_t)) (pTHX);
+typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
 
 /* _ (for $_) must be first in the following list (DEFSV requires it) */
 #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
@@ -1965,12 +1989,14 @@ EXT char *** environ_pointer;
 #    if !defined(DONT_DECLARE_STD) || \
         (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
         defined(__sgi) || \
-        defined(__DGUX)
+        defined(__DGUX) || defined(EPOC)
 extern char ** environ;        /* environment variables supplied via exec */
 #    endif
 #  endif
 #endif
 
+START_EXTERN_C
+
 /* handy constants */
 EXTCONST char PL_warn_uninit[]
   INIT("Use of uninitialized value");
@@ -2229,6 +2255,8 @@ EXTCONST char* PL_block_type[];
 #endif
 #endif
 
+END_EXTERN_C
+
 /*****************************************************************************/
 /* This lexer/parser stuff is currently global since yacc is hard to reenter */
 /*****************************************************************************/
@@ -2284,6 +2312,7 @@ enum {            /* pass one of these to get_vtbl */
 
                                /* Note: the lowest 8 bits are reserved for
                                   stuffing into op->op_private */
+#define HINT_PRIVATE_MASK      0x000000ff
 #define HINT_INTEGER           0x00000001
 #define HINT_STRICT_REFS       0x00000002
 /* #define HINT_notused4       0x00000004 */
@@ -2315,19 +2344,11 @@ enum {          /* pass one of these to get_vtbl */
 #define RsRECORD(sv)  (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
 
 /* Enable variables which are pointers to functions */
-#ifdef PERL_OBJECT
-typedef regexp*(CPerlObj::*regcomp_t) (char* exp, char* xend, PMOP* pm);
-typedef I32 (CPerlObj::*regexec_t) (regexp* prog, char* stringarg,
-                                   char* strend, char* strbeg,
-                                   I32 minend, SV* screamer, void* data,
-                                   U32 flags);
-#else
-typedef regexp*(*regcomp_t) (pTHX_ char* exp, char* xend, PMOP* pm);
-typedef I32 (*regexec_t) (pTHX_ regexp* prog, char* stringarg, char* strend, char*
-                         strbeg, I32 minend, SV* screamer, void* data, 
-                         U32 flags);
+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);
 
-#endif
 
 /* Set up PERLVAR macros for populating structs */
 #define PERLVAR(var,type) type var;
@@ -2336,20 +2357,14 @@ typedef I32 (*regexec_t) (pTHX_ regexp* prog, char* stringarg, char* strend, cha
 
 /* Interpreter exitlist entry */
 typedef struct exitlistentry {
-#ifdef PERL_OBJECT
-    void (*fn) (CPerlObj*, void*);
-#else
-    void (*fn) (pTHX_ void*);
-#endif
+    void (*fn) (pTHXo_ void*);
     void *ptr;
 } PerlExitListEntry;
 
 #ifdef PERL_OBJECT
-extern "C" CPerlObj* perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
-
-#ifdef PERL_OBJECT
-typedef int (CPerlObj::*runops_proc_t) (void);
-#endif  /* PERL_OBJECT */
+#undef perl_alloc
+#define perl_alloc Perl_alloc
+CPerlObj* Perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
 
 #undef EXT
 #define EXT
@@ -2432,7 +2447,7 @@ typedef void *Thread;
 #  define VIRTUAL virtual PERL_CALLCONV
 #else
 #  define VIRTUAL PERL_CALLCONV
-START_EXTERN_C
+/*START_EXTERN_C*/
 #endif
 
 #ifndef NEXT30_NO_ATTRIBUTE
@@ -2448,19 +2463,41 @@ START_EXTERN_C
 int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp);
 #endif
 
-typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*);
-typedef void (*SVFUNC_t) (pTHX_ SV*);
-typedef I32 (*SVCOMPARE_t) (pTHX_ SV*, SV*);
-typedef void (*XSINIT_t) (pTHX);
-typedef void (*ATEXIT_t) (pTHX_ void*);
-typedef void (*XSUBADDR_t) (pTHX_ CV *);
+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
+#endif
 
 #include "proto.h"
 
+#undef PERL_CKDEF
+#undef PERL_PPDEF
+#define PERL_CKDEF(s)  OP *s (pTHX_ OP *o);
+#define PERL_PPDEF(s)  OP *s (pTHX);
+#ifdef PERL_OBJECT
+public:
+#endif
+
 #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
+/*END_EXTERN_C*/
+#endif
+
 #ifndef PERL_OBJECT
-END_EXTERN_C
+/* this has structure inits, so it cannot be included before here */
+#  include "opcode.h"
 #endif
 
 /* The following must follow proto.h as #defines mess up syntax */
@@ -2479,7 +2516,15 @@ END_EXTERN_C
 #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
 
 #ifndef PERL_GLOBAL_STRUCT
-#include "perlvars.h"
+#  ifndef PERL_OBJECT
+START_EXTERN_C
+#  endif
+
+#  include "perlvars.h"
+
+#  ifndef PERL_OBJECT
+END_EXTERN_C
+#  endif
 #endif
 
 #ifndef MULTIPLICITY
@@ -2520,17 +2565,7 @@ PERLVAR(object_compatibility[30],        char)
 #undef PERLVARI
 #undef PERLVARIC
 
-#if defined(HASATTRIBUTE) && defined(WIN32) && !defined(CYGWIN32)
-/*
- * This provides a layer of functions and macros to ensure extensions will
- * get to use the same RTL functions as the core.
- * It has to go here or #define of printf messes up __attribute__
- * stuff in proto.h  
- */
-#ifndef PERL_OBJECT
-#  include <win32iop.h>
-#endif  /* PERL_OBJECT */
-#endif /* WIN32 */
+START_EXTERN_C
 
 #ifdef DOINIT
 
@@ -2736,6 +2771,8 @@ EXTCONST char * PL_AMG_names[NofAMmeth] = {
 EXTCONST char * PL_AMG_names[NofAMmeth];
 #endif /* def INITAMAGIC */
 
+END_EXTERN_C
+
 struct am_table {
   long was_ok_sub;
   long was_ok_am;
@@ -2827,10 +2864,22 @@ typedef struct am_table_short AMTS;
            set_numeric_local();                \
     } STMT_END
 
+#define IS_NUMERIC_RADIX(c)    \
+       ((PL_hints & HINT_LOCALE) && \
+         PL_numeric_radix && (c) == PL_numeric_radix)
+
+#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                           my_atof
+
 #else /* !USE_LOCALE_NUMERIC */
 
-#define SET_NUMERIC_STANDARD()  /**/
-#define SET_NUMERIC_LOCAL()     /**/
+#define SET_NUMERIC_STANDARD()         /**/
+#define SET_NUMERIC_LOCAL()            /**/
+#define IS_NUMERIC_RADIX(c)            (0)
+#define RESTORE_NUMERIC_LOCAL()                /**/
+#define RESTORE_NUMERIC_STANDARD()     /**/
+#define Atof                           atof
 
 #endif /* !USE_LOCALE_NUMERIC */