update Changes
[p5sagit/p5-mst-13.2.git] / perl.h
diff --git a/perl.h b/perl.h
index cd46b7d..60a41ea 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -9,6 +9,8 @@
 #ifndef H_PERL
 #define H_PERL 1
 
+/*#define PERL_IMPLICIT_CONTEXT*/
+
 #ifdef PERL_FOR_X2P
 /*
  * This file is being used for x2p stuff. 
@@ -133,8 +135,9 @@ class CPerlObj;
 #define VOIDUSED 1
 #include "config.h"
 
-#if !defined(PERL_FOR_X2P)
-#  include "embed.h"
+/* XXXXXX testing threads via implicit pointer */
+#ifdef USE_THREADS
+#define PERL_IMPLICIT_CONTEXT
 #endif
 
 #undef START_EXTERN_C
@@ -147,7 +150,7 @@ class CPerlObj;
 #else
 #  define START_EXTERN_C 
 #  define END_EXTERN_C 
-#  define EXTERN_C
+#  define EXTERN_C extern
 #endif
 
 #ifdef OP_IN_REGISTER
@@ -182,7 +185,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #endif
 
 #define NOOP (void)0
-
+#define dNOOP extern int Perl___notused
 #define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
 
 /*
@@ -324,8 +327,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
@@ -379,6 +380,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #   include <stdlib.h>
 #endif
 
+#if !defined(PERL_FOR_X2P)
+#  include "embed.h"
+#endif
+
 #define MEM_SIZE Size_t
 
 /* This comes after <stdlib.h> so we don't try to change the standard
@@ -1299,16 +1304,6 @@ typedef union any ANY;
 #   endif
 #endif
 
-#ifdef PERL_OBJECT
-typedef I32 (*filter_t) (CPerlObj*, int, SV *, int);
-#else
-typedef I32 (*filter_t) (int, SV *, int);
-#endif
-
-#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))
-
 #if defined(__OPEN_VM)
 # include "vmesa/vmesaish.h"
 #endif
@@ -1492,24 +1487,6 @@ typedef pthread_key_t    perl_key;
 #   endif
 #endif
 
-#ifdef UNION_ANY_DEFINITION
-UNION_ANY_DEFINITION;
-#else
-union any {
-    void*      any_ptr;
-    I32                any_i32;
-    IV         any_iv;
-    long       any_long;
-    void       (CPERLscope(*any_dptr)) (void*);
-};
-#endif
-
-#ifdef USE_THREADS
-#define ARGSproto struct perl_thread *thr
-#else
-#define ARGSproto void
-#endif /* USE_THREADS */
-
 #if defined(CYGWIN32)
 /* USEMYBINMODE
  *   This symbol, if defined, indicates that the program should
@@ -1522,22 +1499,77 @@ union any {
             (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : NULL)
 #endif
 
+#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         void
 #  define pTHX_
 #  define _pTHX
-#endif
-
-#ifndef aTHX
 #  define aTHX
 #  define aTHX_
 #  define _aTHX
+#  define dTHXa(a)     dNOOP
+#  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
+union any {
+    void*      any_ptr;
+    I32                any_i32;
+    IV         any_iv;
+    long       any_long;
+    void       (CPERLscope(*any_dptr)) (pTHX_ void*);
+};
+#endif
+
+#ifdef USE_THREADS
+#define ARGSproto struct perl_thread *thr
+#else
+#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);
+#endif
+
+#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"
@@ -1723,7 +1755,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
-#  ifdef PERL_OBJECT
+#  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
@@ -1767,9 +1799,9 @@ Gid_t getegid (void);
 #ifndef assert  /* <assert.h> might have been included somehow */
 #define assert(what)   DEB( {                                          \
        if (!(what)) {                                                  \
-           croak("Assertion failed: file \"%s\", line %d",             \
+           Perl_croak(aTHX_ "Assertion failed: file \"%s\", line %d",  \
                __FILE__, __LINE__);                                    \
-           PerlProc_exit(1);                                                   \
+           PerlProc_exit(1);                                           \
        }})
 #endif
 
@@ -1871,10 +1903,10 @@ typedef Sighandler_t Sigsave_t;
 #  define register
 # endif
 # define PAD_SV(po) pad_sv(po)
-# define RUNOPS_DEFAULT runops_debug
+# define RUNOPS_DEFAULT Perl_runops_debug
 #else
 # define PAD_SV(po) PL_curpad[po]
-# define RUNOPS_DEFAULT runops_standard
+# define RUNOPS_DEFAULT Perl_runops_standard
 #endif
 
 #ifdef MYMALLOC
@@ -1900,17 +1932,10 @@ 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) (void);
-int runops_standard (void);
-#ifdef DEBUGGING
-int runops_debug (void);
-#endif
+#ifdef PERL_OBJECT
+typedef int (CPerlObj::*runops_proc_t) (void);
+#else
+typedef int (*runops_proc_t) (pTHX);
 #endif
 
 /* _ (for $_) must be first in the following list (DEFSV requires it) */
@@ -1941,6 +1966,8 @@ extern char **    environ;        /* environment variables supplied via exec */
 #  endif
 #endif
 
+START_EXTERN_C
+
 /* handy constants */
 EXTCONST char PL_warn_uninit[]
   INIT("Use of uninitialized value");
@@ -2199,6 +2226,8 @@ EXTCONST char* PL_block_type[];
 #endif
 #endif
 
+END_EXTERN_C
+
 /*****************************************************************************/
 /* This lexer/parser stuff is currently global since yacc is hard to reenter */
 /*****************************************************************************/
@@ -2254,6 +2283,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 */
@@ -2292,8 +2322,8 @@ typedef I32 (CPerlObj::*regexec_t) (regexp* prog, char* stringarg,
                                    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*
+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);
 
@@ -2309,7 +2339,7 @@ typedef struct exitlistentry {
 #ifdef PERL_OBJECT
     void (*fn) (CPerlObj*, void*);
 #else
-    void (*fn) (void*);
+    void (*fn) (pTHX_ void*);
 #endif
     void *ptr;
 } PerlExitListEntry;
@@ -2317,10 +2347,6 @@ typedef struct exitlistentry {
 #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 EXT
 #define EXT
 #undef EXTCONST
@@ -2449,7 +2475,9 @@ END_EXTERN_C
 #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
 
 #ifndef PERL_GLOBAL_STRUCT
+START_EXTERN_C
 #include "perlvars.h"
+END_EXTERN_C
 #endif
 
 #ifndef MULTIPLICITY
@@ -2490,99 +2518,89 @@ 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
 
-EXT MGVTBL PL_vtbl_sv =        {magic_get,
-                               magic_set,
-                                       magic_len,
+EXT MGVTBL PL_vtbl_sv =        {Perl_magic_get,
+                               Perl_magic_set,
+                                       Perl_magic_len,
                                                0,      0};
-EXT MGVTBL PL_vtbl_env =       {0,     magic_set_all_env,
-                               0,      magic_clear_all_env,
+EXT MGVTBL PL_vtbl_env =       {0,     Perl_magic_set_all_env,
+                               0,      Perl_magic_clear_all_env,
                                                        0};
-EXT MGVTBL PL_vtbl_envelem =   {0,     magic_setenv,
-                                       0,      magic_clearenv,
+EXT MGVTBL PL_vtbl_envelem =   {0,     Perl_magic_setenv,
+                                       0,      Perl_magic_clearenv,
                                                        0};
 EXT MGVTBL PL_vtbl_sig =       {0,     0,               0, 0, 0};
-EXT MGVTBL PL_vtbl_sigelem =   {magic_getsig,
-                                       magic_setsig,
-                                       0,      magic_clearsig,
+EXT MGVTBL PL_vtbl_sigelem =   {Perl_magic_getsig,
+                                       Perl_magic_setsig,
+                                       0,      Perl_magic_clearsig,
                                                        0};
-EXT MGVTBL PL_vtbl_pack =      {0,     0,      magic_sizepack, magic_wipepack,
+EXT MGVTBL PL_vtbl_pack =      {0,     0,      Perl_magic_sizepack,    Perl_magic_wipepack,
                                                        0};
-EXT MGVTBL PL_vtbl_packelem =  {magic_getpack,
-                               magic_setpack,
-                                       0,      magic_clearpack,
+EXT MGVTBL PL_vtbl_packelem =  {Perl_magic_getpack,
+                               Perl_magic_setpack,
+                                       0,      Perl_magic_clearpack,
                                                        0};
-EXT MGVTBL PL_vtbl_dbline =    {0,     magic_setdbline,
+EXT MGVTBL PL_vtbl_dbline =    {0,     Perl_magic_setdbline,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_isa =       {0,     magic_setisa,
-                                       0,      magic_setisa,
+EXT MGVTBL PL_vtbl_isa =       {0,     Perl_magic_setisa,
+                                       0,      Perl_magic_setisa,
                                                        0};
-EXT MGVTBL PL_vtbl_isaelem =   {0,     magic_setisa,
+EXT MGVTBL PL_vtbl_isaelem =   {0,     Perl_magic_setisa,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_arylen =    {magic_getarylen,
-                               magic_setarylen,
+EXT MGVTBL PL_vtbl_arylen =    {Perl_magic_getarylen,
+                               Perl_magic_setarylen,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_glob =      {magic_getglob,
-                               magic_setglob,
+EXT MGVTBL PL_vtbl_glob =      {Perl_magic_getglob,
+                               Perl_magic_setglob,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_mglob =     {0,     magic_setmglob,
+EXT MGVTBL PL_vtbl_mglob =     {0,     Perl_magic_setmglob,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_nkeys =     {magic_getnkeys,
-                               magic_setnkeys,
+EXT MGVTBL PL_vtbl_nkeys =     {Perl_magic_getnkeys,
+                               Perl_magic_setnkeys,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_taint =     {magic_gettaint,magic_settaint,
+EXT MGVTBL PL_vtbl_taint =     {Perl_magic_gettaint,Perl_magic_settaint,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_substr =    {magic_getsubstr, magic_setsubstr,
+EXT MGVTBL PL_vtbl_substr =    {Perl_magic_getsubstr, Perl_magic_setsubstr,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_vec =       {magic_getvec,
-                               magic_setvec,
+EXT MGVTBL PL_vtbl_vec =       {Perl_magic_getvec,
+                               Perl_magic_setvec,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_pos =       {magic_getpos,
-                               magic_setpos,
+EXT MGVTBL PL_vtbl_pos =       {Perl_magic_getpos,
+                               Perl_magic_setpos,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_bm =        {0,     magic_setbm,
+EXT MGVTBL PL_vtbl_bm =        {0,     Perl_magic_setbm,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_fm =        {0,     magic_setfm,
+EXT MGVTBL PL_vtbl_fm =        {0,     Perl_magic_setfm,
                                        0,      0,      0};
-EXT MGVTBL PL_vtbl_uvar =      {magic_getuvar,
-                               magic_setuvar,
+EXT MGVTBL PL_vtbl_uvar =      {Perl_magic_getuvar,
+                               Perl_magic_setuvar,
                                        0,      0,      0};
 #ifdef USE_THREADS
-EXT MGVTBL PL_vtbl_mutex =     {0,     0,      0,      0,      magic_mutexfree};
+EXT MGVTBL PL_vtbl_mutex =     {0,     0,      0,      0,      Perl_magic_mutexfree};
 #endif /* USE_THREADS */
-EXT MGVTBL PL_vtbl_defelem = {magic_getdefelem,magic_setdefelem,
+EXT MGVTBL PL_vtbl_defelem = {Perl_magic_getdefelem,Perl_magic_setdefelem,
                                        0,      0,      0};
 
-EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, magic_freeregexp};
-EXT MGVTBL PL_vtbl_regdata = {0, 0, magic_regdata_cnt, 0, 0};
-EXT MGVTBL PL_vtbl_regdatum = {magic_regdatum_get, 0, 0, 0, 0};
+EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, Perl_magic_freeregexp};
+EXT MGVTBL PL_vtbl_regdata = {0, 0, Perl_magic_regdata_cnt, 0, 0};
+EXT MGVTBL PL_vtbl_regdatum = {Perl_magic_regdatum_get, 0, 0, 0, 0};
 
 #ifdef USE_LOCALE_COLLATE
 EXT MGVTBL PL_vtbl_collxfrm = {0,
-                               magic_setcollxfrm,
+                               Perl_magic_setcollxfrm,
                                        0,      0,      0};
 #endif
 
-EXT MGVTBL PL_vtbl_amagic =       {0,     magic_setamagic,
-                                        0,      0,      magic_setamagic};
-EXT MGVTBL PL_vtbl_amagicelem =   {0,     magic_setamagic,
-                                        0,      0,      magic_setamagic};
+EXT MGVTBL PL_vtbl_amagic =       {0,     Perl_magic_setamagic,
+                                        0,      0,      Perl_magic_setamagic};
+EXT MGVTBL PL_vtbl_amagicelem =   {0,     Perl_magic_setamagic,
+                                        0,      0,      Perl_magic_setamagic};
 
 EXT MGVTBL PL_vtbl_backref =     {0,   0,
-                                       0,      0,      magic_killbackrefs};
+                                       0,      0,      Perl_magic_killbackrefs};
 
 #else /* !DOINIT */
 
@@ -2706,6 +2724,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;