initial stub implementation of implicit thread/this
[p5sagit/p5-mst-13.2.git] / perl.h
diff --git a/perl.h b/perl.h
index febcdf4..cd46b7d 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -107,9 +107,7 @@ class CPerlObj;
 #define PERL_OBJECT_THIS this
 #define _PERL_OBJECT_THIS ,this
 #define PERL_OBJECT_THIS_ this,
-#define CALLRUNOPS (this->*PL_runops)
-#define CALLREGCOMP (this->*PL_regcompp)
-#define CALLREGEXEC (this->*PL_regexecp)
+#define CALL_FPTR(fptr) (this->*fptr)
 
 #else /* !PERL_OBJECT */
 
@@ -123,12 +121,15 @@ class CPerlObj;
 #define PERL_OBJECT_THIS
 #define _PERL_OBJECT_THIS
 #define PERL_OBJECT_THIS_
-#define CALLRUNOPS (*PL_runops)
-#define CALLREGCOMP (*PL_regcompp)
-#define CALLREGEXEC (*PL_regexecp)
+#define CALL_FPTR(fptr) (*fptr)
 
 #endif /* PERL_OBJECT */
 
+#define CALLRUNOPS  CALL_FPTR(PL_runops)
+#define CALLREGCOMP CALL_FPTR(PL_regcompp)
+#define CALLREGEXEC CALL_FPTR(PL_regexecp)
+#define CALLPROTECT CALL_FPTR(PL_protect)
+
 #define VOIDUSED 1
 #include "config.h"
 
@@ -218,7 +219,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)
+#if defined(MSDOS) || defined(atarist) || defined(WIN32) || defined(CYGWIN32)
 #define DOSISH 1
 #endif
 
@@ -392,12 +393,12 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #  else
 #    define EMBEDMYMALLOC      /* for compatibility */
 #  endif
-Malloc_t Perl_malloc _((MEM_SIZE nbytes));
-Malloc_t Perl_calloc _((MEM_SIZE elements, MEM_SIZE size));
-Malloc_t Perl_realloc _((Malloc_t where, MEM_SIZE nbytes));
+Malloc_t Perl_malloc (MEM_SIZE nbytes);
+Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size);
+Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes);
 /* 'mfree' rather than 'free', since there is already a 'perl_free'
  * that causes clashes with case-insensitive linkers */
-Free_t   Perl_mfree _((Malloc_t where));
+Free_t   Perl_mfree (Malloc_t where);
 
 #  define safemalloc  Perl_malloc
 #  define safecalloc  Perl_calloc
@@ -435,7 +436,7 @@ Free_t   Perl_mfree _((Malloc_t where));
 #ifdef HAS_MEMCPY
 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 #    ifndef memcpy
-        extern char * memcpy _((char*, char*, int));
+        extern char * memcpy (char*, char*, int);
 #    endif
 #  endif
 #else
@@ -451,7 +452,7 @@ Free_t   Perl_mfree _((Malloc_t where));
 #ifdef HAS_MEMSET
 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 #    ifndef memset
-       extern char *memset _((char*, int, int));
+       extern char *memset (char*, int, int);
 #    endif
 #  endif
 #else
@@ -477,7 +478,7 @@ Free_t   Perl_mfree _((Malloc_t where));
 #if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
 #  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
 #    ifndef memcmp
-       extern int memcmp _((char*, char*, int));
+       extern int memcmp (char*, char*, int);
 #    endif
 #  endif
 #  ifdef BUGGY_MSC
@@ -501,6 +502,12 @@ Free_t   Perl_mfree _((Malloc_t where));
 #   endif
 #endif
 
+#ifndef memchr
+#   ifndef HAS_MEMCHR
+#       define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1)
+#   endif
+#endif
+
 #ifndef HAS_BCMP
 #   ifndef bcmp
 #      define bcmp(s1,s2,l) memcmp(s1,s2,l)
@@ -604,10 +611,10 @@ Free_t   Perl_mfree _((Malloc_t where));
 
 #ifdef HAS_STRERROR
 #       ifdef VMS
-       char *strerror _((int,...));
+       char *strerror (int,...);
 #       else
 #ifndef DONT_DECLARE_STD
-       char *strerror _((int));
+       char *strerror (int);
 #endif
 #       endif
 #       ifndef Strerror
@@ -1293,9 +1300,9 @@ typedef union any ANY;
 #endif
 
 #ifdef PERL_OBJECT
-typedef I32 (*filter_t) _((CPerlObj*, int, SV *, int));
+typedef I32 (*filter_t) (CPerlObj*, int, SV *, int);
 #else
-typedef I32 (*filter_t) _((int, SV *, int));
+typedef I32 (*filter_t) (int, SV *, int);
 #endif
 
 #define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
@@ -1454,7 +1461,15 @@ typedef pthread_key_t    perl_key;
  * XXX the default needs a Configure test, as it may not work everywhere.
  */
 #ifndef PERL_FLUSHALL_FOR_CHILD
-#define PERL_FLUSHALL_FOR_CHILD        PerlIO_flush((PerlIO*)NULL)
+# if defined(FFLUSH_NULL) || defined(USE_SFIO)
+#  define PERL_FLUSHALL_FOR_CHILD      PerlIO_flush((PerlIO*)NULL)
+# else
+#  ifdef FFLUSH_ALL
+#   define PERL_FLUSHALL_FOR_CHILD     my_fflush_all()
+#  else
+#   define PERL_FLUSHALL_FOR_CHILD     (void)0
+#  endif
+# endif
 #endif
 
 /* Some unistd.h's give a prototype for pause() even though
@@ -1485,7 +1500,7 @@ union any {
     I32                any_i32;
     IV         any_iv;
     long       any_long;
-    void       (CPERLscope(*any_dptr)) _((void*));
+    void       (CPERLscope(*any_dptr)) (void*);
 };
 #endif
 
@@ -1495,11 +1510,7 @@ union any {
 #define ARGSproto void
 #endif /* USE_THREADS */
 
-/* Work around some cygwin32 problems with importing global symbols */
 #if defined(CYGWIN32)
-#  if defined(DLLIMPORT) 
-#   include "cw32imp.h"
-#  endif
 /* USEMYBINMODE
  *   This symbol, if defined, indicates that the program should
  *   use the routine my_binmode(FILE *fp, char iotype) to insure
@@ -1511,6 +1522,22 @@ union any {
             (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : NULL)
 #endif
 
+#ifndef pTHX
+#  define pTHX void
+#  define pTHX_
+#  define _pTHX
+#endif
+
+#ifndef aTHX
+#  define aTHX
+#  define aTHX_
+#  define _aTHX
+#endif
+
+#ifndef STATIC
+#  define STATIC static
+#endif
+
 #include "regexp.h"
 #include "sv.h"
 #include "util.h"
@@ -1527,8 +1554,6 @@ union any {
 #include "mg.h"
 #include "scope.h"
 #include "warning.h"
-#include "bytecode.h"
-#include "byterun.h"
 #include "utf8.h"
 
 /* Current curly descriptor */
@@ -1556,7 +1581,8 @@ struct _sublex_info {
 
 typedef struct magic_state MGS;        /* struct magic_state defined in mg.c */
 
-#ifdef PERL_OBJECT
+/* Length of a variant. */
+
 typedef struct {
     I32 len_min;
     I32 len_delta;
@@ -1576,7 +1602,6 @@ typedef struct {
 } scan_data_t;
 
 typedef I32 CHECKPOINT;
-#endif /* PERL_OBJECT */
 
 #if defined(iAPX286) || defined(M_I286) || defined(I80286)
 #   define I286
@@ -1656,6 +1681,11 @@ typedef I32 CHECKPOINT;
 #define U_V(what) (cast_uv((double)(what)))
 #endif
 
+/* Used with UV/IV arguments: */
+                                       /* XXXX: need to speed it up */
+#define CLUMP_2UV(iv)  ((iv) < 0 ? 0 : (UV)(iv))
+#define CLUMP_2IV(uv)  ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv))
+
 struct Outrec {
     I32                o_lines;
     char       *o_str;
@@ -1671,10 +1701,10 @@ struct Outrec {
 #endif
 
 #ifndef __cplusplus
-Uid_t getuid _((void));
-Uid_t geteuid _((void));
-Gid_t getgid _((void));
-Gid_t getegid _((void));
+Uid_t getuid (void);
+Uid_t geteuid (void);
+Gid_t getgid (void);
+Gid_t getegid (void);
 #endif
 
 #ifndef Perl_debug_log
@@ -1693,7 +1723,11 @@ 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
-#define DEBUG_m(a) if (PL_curinterp && PL_debug & 128) a
+#  ifdef PERL_OBJECT
+#    define DEBUG_m(a) if (PL_debug & 128)     a
+#  else
+#    define DEBUG_m(a) if (PL_curinterp && PL_debug & 128)     a
+#  endif
 #define DEBUG_f(a) if (PL_debug & 256) a
 #define DEBUG_r(a) if (PL_debug & 512) a
 #define DEBUG_x(a) if (PL_debug & 1024)        a
@@ -1740,15 +1774,15 @@ Gid_t getegid _((void));
 #endif
 
 struct ufuncs {
-    I32 (*uf_val)_((IV, SV*));
-    I32 (*uf_set)_((IV, SV*));
+    I32 (*uf_val)(IV, SV*);
+    I32 (*uf_set)(IV, SV*);
     IV uf_index;
 };
 
 /* Fix these up for __STDC__ */
 #ifndef DONT_DECLARE_STD
-char *mktemp _((char*));
-double atof _((const char*));
+char *mktemp (char*);
+double atof (const char*);
 #endif
 
 #ifndef STANDARD_C
@@ -1769,17 +1803,17 @@ char *strcpy(), *strcat();
 #    include <math.h>
 #else
 START_EXTERN_C
-           double exp _((double));
-           double log _((double));
-           double log10 _((double));
-           double sqrt _((double));
-           double frexp _((double,int*));
-           double ldexp _((double,int));
-           double modf _((double,double*));
-           double sin _((double));
-           double cos _((double));
-           double atan2 _((double,double));
-           double pow _((double,double));
+           double exp (double);
+           double log (double);
+           double log10 (double);
+           double sqrt (double);
+           double frexp (double,int*);
+           double ldexp (double,int);
+           double modf (double,double*);
+           double sin (double);
+           double cos (double);
+           double atan2 (double,double);
+           double pow (double,double);
 END_EXTERN_C
 #endif
 
@@ -1788,21 +1822,21 @@ END_EXTERN_C
 char *crypt ();       /* Maybe more hosts will need the unprototyped version */
 #  else
 #    if !defined(WIN32) || !defined(HAVE_DES_FCRYPT)
-char *crypt _((const char*, const char*));
+char *crypt (const char*, const char*);
 #    endif /* !WIN32 && !HAVE_CRYPT_SOURCE */
 #  endif /* !NeXT && !__NeXT__ */
 #  ifndef DONT_DECLARE_STD
 #    ifndef getenv
-char *getenv _((const char*));
+char *getenv (const char*);
 #    endif /* !getenv */
-Off_t lseek _((int,Off_t,int));
+Off_t lseek (int,Off_t,int);
 #  endif /* !DONT_DECLARE_STD */
-char *getlogin _((void));
+char *getlogin (void);
 #endif /* !__cplusplus */
 
 #ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
 #define UNLINK unlnk
-I32 unlnk _((char*));
+I32 unlnk (char*);
 #else
 #define UNLINK PerlLIO_unlink
 #endif
@@ -1820,7 +1854,7 @@ I32 unlnk _((char*));
 #  endif
 #endif
 
-typedef Signal_t (*Sighandler_t) _((int));
+typedef Signal_t (*Sighandler_t) (int);
 
 #ifdef HAS_SIGACTION
 typedef struct sigaction Sigsave_t;
@@ -1872,10 +1906,10 @@ typedef Sighandler_t Sigsave_t;
  */
 
 #ifndef PERL_OBJECT
-typedef int (*runops_proc_t) _((void));
-int runops_standard _((void));
+typedef int (*runops_proc_t) (void);
+int runops_standard (void);
 #ifdef DEBUGGING
-int runops_debug _((void));
+int runops_debug (void);
 #endif
 #endif
 
@@ -1897,12 +1931,13 @@ EXT char *** environ_pointer;
 #  endif
 #else
    /* VMS and some other platforms don't use the environ array */
-#  if !defined(VMS) || \
-      !defined(DONT_DECLARE_STD) || \
-      (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
-      defined(__sgi) || \
-      defined(__DGUX)
+#  if !defined(VMS)
+#    if !defined(DONT_DECLARE_STD) || \
+        (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
+        defined(__sgi) || \
+        defined(__DGUX)
 extern char ** environ;        /* environment variables supplied via exec */
+#    endif
 #  endif
 #endif
 
@@ -2213,7 +2248,8 @@ enum {            /* pass one of these to get_vtbl */
     want_vtbl_mutex,
 #endif
     want_vtbl_regdata,
-    want_vtbl_regdatum
+    want_vtbl_regdatum,
+    want_vtbl_backref
 };
 
                                /* Note: the lowest 8 bits are reserved for
@@ -2250,16 +2286,16 @@ enum {          /* pass one of these to get_vtbl */
 
 /* 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));
+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) _((char* exp, char* xend, PMOP* pm));
-typedef I32 (*regexec_t) _((regexp* prog, char* stringarg, char* strend, char*
-                           strbeg, I32 minend, SV* screamer, void* data, 
-                           U32 flags));
+typedef regexp*(*regcomp_t) (char* exp, char* xend, PMOP* pm);
+typedef I32 (*regexec_t) (regexp* prog, char* stringarg, char* strend, char*
+                         strbeg, I32 minend, SV* screamer, void* data, 
+                         U32 flags);
 
 #endif
 
@@ -2271,18 +2307,18 @@ typedef I32 (*regexec_t) _((regexp* prog, char* stringarg, char* strend, char*
 /* Interpreter exitlist entry */
 typedef struct exitlistentry {
 #ifdef PERL_OBJECT
-    void (*fn) _((CPerlObj*, void*));
+    void (*fn) (CPerlObj*, void*);
 #else
-    void (*fn) _((void*));
+    void (*fn) (void*);
 #endif
     void *ptr;
 } PerlExitListEntry;
 
 #ifdef PERL_OBJECT
-extern "C" CPerlObj* perl_alloc _((IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*));
+extern "C" CPerlObj* perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
 
 #ifdef PERL_OBJECT
-typedef int (CPerlObj::*runops_proc_t) _((void));
+typedef int (CPerlObj::*runops_proc_t) (void);
 #endif  /* PERL_OBJECT */
 
 #undef EXT
@@ -2308,7 +2344,7 @@ struct perl_vars {
 EXT struct perl_vars PL_Vars;
 EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);
 #else /* PERL_CORE */
-#if !defined(__GNUC__) || !defined(WIN32)
+#if !defined(__GNUC__) || !(defined(WIN32) || defined(CYGWIN32))
 EXT
 #endif /* WIN32 */
 struct perl_vars *PL_VarsPtr;
@@ -2357,8 +2393,46 @@ typedef void *Thread;
 
 #include "thread.h"
 #include "pp.h"
+
+#ifndef PERL_CALLCONV
+#  define PERL_CALLCONV
+#endif 
+
+#ifdef PERL_OBJECT
+#  define VIRTUAL virtual PERL_CALLCONV
+#else
+#  define VIRTUAL PERL_CALLCONV
+START_EXTERN_C
+#endif
+
+#ifndef NEXT30_NO_ATTRIBUTE
+#  ifndef HASATTRIBUTE       /* disable GNU-cc attribute checking? */
+#    ifdef  __attribute__      /* Avoid possible redefinition errors */
+#      undef  __attribute__
+#    endif
+#    define __attribute__(attr)
+#  endif
+#endif
+
+#ifdef USE_PURE_BISON
+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 *);
+
 #include "proto.h"
 
+#include "pp_proto.h"
+
+#ifndef PERL_OBJECT
+END_EXTERN_C
+#endif
+
 /* The following must follow proto.h as #defines mess up syntax */
 
 #if !defined(PERL_FOR_X2P)
@@ -2416,7 +2490,7 @@ PERLVAR(object_compatibility[30], char)
 #undef PERLVARI
 #undef PERLVARIC
 
-#if defined(HASATTRIBUTE) && defined(WIN32)
+#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.
@@ -2507,6 +2581,9 @@ EXT MGVTBL PL_vtbl_amagic =       {0,     magic_setamagic,
 EXT MGVTBL PL_vtbl_amagicelem =   {0,     magic_setamagic,
                                         0,      0,      magic_setamagic};
 
+EXT MGVTBL PL_vtbl_backref =     {0,   0,
+                                       0,      0,      magic_killbackrefs};
+
 #else /* !DOINIT */
 
 EXT MGVTBL PL_vtbl_sv;
@@ -2547,6 +2624,8 @@ EXT MGVTBL PL_vtbl_collxfrm;
 EXT MGVTBL PL_vtbl_amagic;
 EXT MGVTBL PL_vtbl_amagicelem;
 
+EXT MGVTBL PL_vtbl_backref;
+
 #endif /* !DOINIT */
 
 enum {
@@ -2708,14 +2787,14 @@ typedef struct am_table_short AMTS;
 
 #define SET_NUMERIC_STANDARD() \
     STMT_START {                               \
-       if (! PL_numeric_standard)                      \
-           perl_set_numeric_standard();        \
+       if (! PL_numeric_standard)              \
+           set_numeric_standard();             \
     } STMT_END
 
 #define SET_NUMERIC_LOCAL() \
     STMT_START {                               \
        if (! PL_numeric_local)                 \
-           perl_set_numeric_local();           \
+           set_numeric_local();                \
     } STMT_END
 
 #else /* !USE_LOCALE_NUMERIC */