X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=7ef943212c15e0edae399ff182534988432a7b49;hb=d43ce814c3413c5d667db1dd8ade5d571ac81c1f;hp=8f5082c011860023fba715b2b1b0756f88822a6e;hpb=39398f3f0ecd7e1d0d9f68b83052e76ea7150b75;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index 8f5082c..7ef9432 100644 --- 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. @@ -107,9 +109,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,17 +123,21 @@ 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" -#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 @@ -146,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 @@ -181,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 /* @@ -218,7 +222,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 @@ -323,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 @@ -378,6 +380,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # include #endif +#if !defined(PERL_FOR_X2P) +# include "embed.h" +#endif + #define MEM_SIZE Size_t /* This comes after so we don't try to change the standard @@ -392,12 +398,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 +441,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 +457,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 +483,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 +507,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 +616,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 @@ -1292,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 @@ -1449,6 +1451,22 @@ typedef pthread_key_t perl_key; # define STATUS_ALL_FAILURE (PL_statusvalue = 1) #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. + */ +#ifndef PERL_FLUSHALL_FOR_CHILD +# 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 HAS_PAUSE ends up undefined. This causes the #define below to be rejected by the compmiler. Sigh. @@ -1469,6 +1487,56 @@ typedef pthread_key_t perl_key; # endif #endif +#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 : 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_ +# define _pTHX +# 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 @@ -1477,32 +1545,31 @@ union any { I32 any_i32; IV any_iv; long any_long; - void (CPERLscope(*any_dptr)) _((void*)); + void (CPERLscope(*any_dptr)) (pTHX_ void*); }; #endif #ifdef USE_THREADS #define ARGSproto struct perl_thread *thr #else -#define ARGSproto void +#define ARGSproto #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 - * 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 : NULL) +#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" @@ -1519,8 +1586,6 @@ union any { #include "mg.h" #include "scope.h" #include "warning.h" -#include "bytecode.h" -#include "byterun.h" #include "utf8.h" /* Current curly descriptor */ @@ -1548,7 +1613,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; @@ -1568,7 +1634,6 @@ typedef struct { } scan_data_t; typedef I32 CHECKPOINT; -#endif /* PERL_OBJECT */ #if defined(iAPX286) || defined(M_I286) || defined(I80286) # define I286 @@ -1648,6 +1713,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; @@ -1663,10 +1733,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 @@ -1685,7 +1755,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 +# 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 +# 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 @@ -1725,22 +1799,22 @@ Gid_t getegid _((void)); #ifndef assert /* 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 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 @@ -1761,17 +1835,17 @@ char *strcpy(), *strcat(); # include #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 @@ -1780,21 +1854,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 @@ -1812,7 +1886,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; @@ -1829,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 @@ -1858,17 +1932,10 @@ typedef Sighandler_t Sigsave_t; #endif -/* - * These need prototyping here because 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) */ @@ -1889,15 +1956,18 @@ 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 +START_EXTERN_C + /* handy constants */ EXTCONST char PL_warn_uninit[] INIT("Use of uninitialized value"); @@ -2156,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 */ /*****************************************************************************/ @@ -2205,11 +2277,13 @@ 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 stuffing into op->op_private */ +#define HINT_PRIVATE_MASK 0x000000ff #define HINT_INTEGER 0x00000001 #define HINT_STRICT_REFS 0x00000002 /* #define HINT_notused4 0x00000004 */ @@ -2242,16 +2316,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) (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); #endif @@ -2263,19 +2337,15 @@ 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) (pTHX_ void*); #endif 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 */ +extern "C" CPerlObj* perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); #undef EXT #define EXT @@ -2300,7 +2370,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; @@ -2349,8 +2419,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) @@ -2367,7 +2475,9 @@ typedef void *Thread; #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 @@ -2408,96 +2518,89 @@ PERLVAR(object_compatibility[30], char) #undef PERLVARI #undef PERLVARIC -#if defined(HASATTRIBUTE) && defined(WIN32) -/* - * 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 -#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, Perl_magic_killbackrefs}; #else /* !DOINIT */ @@ -2539,6 +2642,8 @@ EXT MGVTBL PL_vtbl_collxfrm; EXT MGVTBL PL_vtbl_amagic; EXT MGVTBL PL_vtbl_amagicelem; +EXT MGVTBL PL_vtbl_backref; + #endif /* !DOINIT */ enum { @@ -2619,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; @@ -2700,20 +2807,32 @@ 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 +#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(s) Perl_my_atof(s) + #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(s) atof(s) #endif /* !USE_LOCALE_NUMERIC */