# define EXTERN_C extern
#endif
+/* Fallback definitions in case we don't have definitions from config.h.
+ This should only matter for systems that don't use Configure and
+ haven't been modified to define PERL_STATIC_INLINE yet.
+*/
+#if !defined(PERL_STATIC_INLINE)
+# ifdef HAS_STATIC_INLINE
+# define PERL_STATIC_INLINE static inline
+# else
+# define PERL_STATIC_INLINE static
+# endif
+#endif
+
#ifdef PERL_GLOBAL_STRUCT
# ifndef PERL_GET_VARS
# ifdef PERL_GLOBAL_STRUCT_PRIVATE
#endif
#define STATIC static
+
+#ifndef PERL_CORE
+/* Do not use these macros. They were part of PERL_OBJECT, which was an
+ * implementation of multiplicity using C++ objects. They have been left
+ * here solely for the sake of XS code which has incorrectly
+ * cargo-culted them.
+ */
#define CPERLscope(x) x
#define CPERLarg void
#define CPERLarg_
#define _PERL_OBJECT_THIS
#define PERL_OBJECT_THIS_
#define CALL_FPTR(fptr) (*fptr)
+#endif /* !PERL_CORE */
-#define CALLRUNOPS CALL_FPTR(PL_runops)
+#define CALLRUNOPS PL_runops
#define CALLREGCOMP(sv, flags) Perl_pregcomp(aTHX_ (sv),(flags))
-#define CALLREGCOMP_ENG(prog, sv, flags) \
- CALL_FPTR(((prog)->comp))(aTHX_ sv, flags)
+#define CALLREGCOMP_ENG(prog, sv, flags) (prog)->comp(aTHX_ sv, flags)
#define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,screamer,data,flags) \
- CALL_FPTR(RX_ENGINE(prog)->exec)(aTHX_ (prog),(stringarg),(strend), \
+ RX_ENGINE(prog)->exec(aTHX_ (prog),(stringarg),(strend), \
(strbeg),(minend),(screamer),(data),(flags))
#define CALLREG_INTUIT_START(prog,sv,strpos,strend,flags,data) \
- CALL_FPTR(RX_ENGINE(prog)->intuit)(aTHX_ (prog), (sv), (strpos), \
+ RX_ENGINE(prog)->intuit(aTHX_ (prog), (sv), (strpos), \
(strend),(flags),(data))
#define CALLREG_INTUIT_STRING(prog) \
- CALL_FPTR(RX_ENGINE(prog)->checkstr)(aTHX_ (prog))
+ RX_ENGINE(prog)->checkstr(aTHX_ (prog))
#define CALLREGFREE(prog) \
Perl_pregfree(aTHX_ (prog))
#define CALLREGFREE_PVT(prog) \
- if(prog) CALL_FPTR(RX_ENGINE(prog)->free)(aTHX_ (prog))
+ if(prog) RX_ENGINE(prog)->free(aTHX_ (prog))
#define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \
- CALL_FPTR(RX_ENGINE(rx)->numbered_buff_FETCH)(aTHX_ (rx),(paren),(usesv))
+ RX_ENGINE(rx)->numbered_buff_FETCH(aTHX_ (rx),(paren),(usesv))
#define CALLREG_NUMBUF_STORE(rx,paren,value) \
- CALL_FPTR(RX_ENGINE(rx)->numbered_buff_STORE)(aTHX_ (rx),(paren),(value))
+ RX_ENGINE(rx)->numbered_buff_STORE(aTHX_ (rx),(paren),(value))
#define CALLREG_NUMBUF_LENGTH(rx,sv,paren) \
- CALL_FPTR(RX_ENGINE(rx)->numbered_buff_LENGTH)(aTHX_ (rx),(sv),(paren))
+ RX_ENGINE(rx)->numbered_buff_LENGTH(aTHX_ (rx),(sv),(paren))
#define CALLREG_NAMED_BUFF_FETCH(rx, key, flags) \
- CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_FETCH))
+ RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), NULL, ((flags) | RXapif_FETCH))
#define CALLREG_NAMED_BUFF_STORE(rx, key, value, flags) \
- CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), (value), ((flags) | RXapif_STORE))
+ RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), (value), ((flags) | RXapif_STORE))
#define CALLREG_NAMED_BUFF_DELETE(rx, key, flags) \
- CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx),(key), NULL, ((flags) | RXapif_DELETE))
+ RX_ENGINE(rx)->named_buff(aTHX_ (rx),(key), NULL, ((flags) | RXapif_DELETE))
#define CALLREG_NAMED_BUFF_CLEAR(rx, flags) \
- CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_CLEAR))
+ RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_CLEAR))
#define CALLREG_NAMED_BUFF_EXISTS(rx, key, flags) \
- CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), (key), NULL, ((flags) | RXapif_EXISTS))
+ RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), NULL, ((flags) | RXapif_EXISTS))
#define CALLREG_NAMED_BUFF_FIRSTKEY(rx, flags) \
- CALL_FPTR(RX_ENGINE(rx)->named_buff_iter)(aTHX_ (rx), NULL, ((flags) | RXapif_FIRSTKEY))
+ RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), NULL, ((flags) | RXapif_FIRSTKEY))
#define CALLREG_NAMED_BUFF_NEXTKEY(rx, lastkey, flags) \
- CALL_FPTR(RX_ENGINE(rx)->named_buff_iter)(aTHX_ (rx), (lastkey), ((flags) | RXapif_NEXTKEY))
+ RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), (lastkey), ((flags) | RXapif_NEXTKEY))
#define CALLREG_NAMED_BUFF_SCALAR(rx, flags) \
- CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_SCALAR))
+ RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_SCALAR))
#define CALLREG_NAMED_BUFF_COUNT(rx) \
- CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, RXapif_REGNAMES_COUNT)
+ RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, RXapif_REGNAMES_COUNT)
#define CALLREG_NAMED_BUFF_ALL(rx, flags) \
- CALL_FPTR(RX_ENGINE(rx)->named_buff)(aTHX_ (rx), NULL, NULL, flags)
+ RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, flags)
#define CALLREG_PACKAGE(rx) \
- CALL_FPTR(RX_ENGINE(rx)->qr_package)(aTHX_ (rx))
+ RX_ENGINE(rx)->qr_package(aTHX_ (rx))
#if defined(USE_ITHREADS)
#define CALLREGDUPE(prog,param) \
Perl_re_dup(aTHX_ (prog),(param))
#define CALLREGDUPE_PVT(prog,param) \
- (prog ? CALL_FPTR(RX_ENGINE(prog)->dupe)(aTHX_ (prog),(param)) \
+ (prog ? RX_ENGINE(prog)->dupe(aTHX_ (prog),(param)) \
: (REGEXP *)NULL)
#endif
#define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size
#endif
+/* sv_grow() will expand strings by at least a certain percentage of
+ the previously *used* length to avoid excessive calls to realloc().
+ The default is 25% of the current length.
+*/
+#ifndef PERL_STRLEN_EXPAND_SHIFT
+# define PERL_STRLEN_EXPAND_SHIFT 2
+#endif
+
#if defined(STANDARD_C) && defined(I_STDDEF)
# include <stddef.h>
# define STRUCT_OFFSET(s,m) offsetof(s,m)
typedef struct pvop PVOP;
typedef struct loop LOOP;
+typedef struct block_hooks BHK;
+
typedef struct interpreter PerlInterpreter;
/* Amdahl's <ksync.h> has struct sv */
#include "warnings.h"
#include "utf8.h"
+/* these would be in doio.h if there was such a file */
+#define my_stat() my_stat_flags(SV_GMAGIC)
+#define my_lstat() my_lstat_flags(SV_GMAGIC)
+
/* defined in sv.c, but also used in [ach]v.c */
#undef _XPV_HEAD
#undef _XPVMG_HEAD
#define DEBUG_SCOPE(where) \
- DEBUG_l(WITH_THR( \
+ DEBUG_l( \
Perl_deb(aTHX_ "%s scope %ld (savestack=%ld) at %s:%d\n", \
where, (long)PL_scopestack_ix, (long)PL_savestack_ix, \
- __FILE__, __LINE__)));
+ __FILE__, __LINE__));
# endif
#endif
-typedef int (CPERLscope(*runops_proc_t)) (pTHX);
-typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv);
-typedef int (CPERLscope(*thrhook_proc_t)) (pTHX);
-typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
-typedef bool (CPERLscope(*destroyable_proc_t)) (pTHX_ SV *sv);
-typedef void (CPERLscope(*despatch_signals_proc_t)) (pTHX);
+typedef int (*runops_proc_t)(pTHX);
+typedef void (*share_proc_t) (pTHX_ SV *sv);
+typedef int (*thrhook_proc_t) (pTHX);
+typedef OP* (*PPADDR_t[]) (pTHX);
+typedef bool (*destroyable_proc_t) (pTHX_ SV *sv);
+typedef void (*despatch_signals_proc_t) (pTHX);
/* _ (for $_) must be first in the following list (DEFSV requires it) */
#define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
PERL_DEBUG_PAD(i))
/* Enable variables which are pointers to functions */
-typedef void (CPERLscope(*peep_t))(pTHX_ OP* o);
-typedef regexp*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm);
-typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg,
+typedef void (*peep_t)(pTHX_ OP* o);
+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 char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv,
+typedef char* (*re_intuit_start_t) (pTHX_ regexp *prog, SV *sv,
char *strpos, char *strend,
U32 flags,
re_scream_pos_data *d);
-typedef SV* (CPERLscope(*re_intuit_string_t)) (pTHX_ regexp *prog);
-typedef void (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r);
-typedef regexp*(CPERLscope(*regdupe_t)) (pTHX_ const regexp* r, CLONE_PARAMS *param);
+typedef SV* (*re_intuit_string_t) (pTHX_ regexp *prog);
+typedef void (*regfree_t) (pTHX_ struct regexp* r);
+typedef regexp* (*regdupe_t) (pTHX_ const regexp* r, CLONE_PARAMS *param);
typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*);
typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*);
#define PERLVARIC(var,type,init) type var;
#define PERLVARISC(var,init) const char var[sizeof(init)];
-typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
-typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
-typedef void(CPERLscope(*Perl_ophook_t))(pTHX_ OP*);
-typedef int (CPERLscope(*Perl_keyword_plugin_t))(pTHX_ char*, STRLEN, OP**);
+typedef OP* (*Perl_ppaddr_t)(pTHX);
+typedef OP* (*Perl_check_t) (pTHX_ OP*);
+typedef void(*Perl_ophook_t)(pTHX_ OP*);
+typedef int (*Perl_keyword_plugin_t)(pTHX_ char*, STRLEN, OP**);
#define KEYWORD_PLUGIN_DECLINE 0
#define KEYWORD_PLUGIN_STMT 1
STRINGIFY(PERL_VERSION) "." \
STRINGIFY(PERL_SUBVERSION)
+#define PERL_API_VERSION_STRING STRINGIFY(PERL_API_REVISION) "." \
+ STRINGIFY(PERL_API_VERSION) "." \
+ STRINGIFY(PERL_API_SUBVERSION)
+
#ifdef PERL_GLOBAL_STRUCT
struct perl_vars {
# include "perlvars.h"
* not the same beast. ANSI doesn't allow the assignment from one to the other.
* (although most, but not all, compilers are prepared to do it)
*/
+
+/* args are:
+ vtable
+ get
+ set
+ len
+ clear
+ free
+ copy
+ dup
+ local
+*/
+
MGVTBL_SET(
PL_vtbl_sv,
MEMBER_TO_FPTR(Perl_magic_get),
#ifndef PERL_MICRO
# ifndef PERL_ASYNC_CHECK
-# define PERL_ASYNC_CHECK() if (PL_sig_pending) CALL_FPTR(PL_signalhook)(aTHX)
+# define PERL_ASYNC_CHECK() if (PL_sig_pending) PL_signalhook(aTHX)
# endif
#endif
#if defined(PERL_IMPLICIT_CONTEXT)
-#ifdef PERL_GLOBAL_STRUCT_PRIVATE
-
-/* This must appear in all extensions that define a my_cxt_t structure,
+/* START_MY_CXT must appear in all extensions that define a my_cxt_t structure,
* right after the definition (i.e. at file scope). The non-threads
* case below uses it to declare the data as static. */
-#define START_MY_CXT
-#define MY_CXT_INDEX Perl_my_cxt_index(aTHX_ MY_CXT_KEY)
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+# define START_MY_CXT
+# define MY_CXT_INDEX Perl_my_cxt_index(aTHX_ MY_CXT_KEY)
+# define MY_CXT_INIT_ARG MY_CXT_KEY
+# else
+# define START_MY_CXT static int my_cxt_index = -1;
+# define MY_CXT_INDEX my_cxt_index
+# define MY_CXT_INIT_ARG &my_cxt_index
+# endif /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */
/* Creates and zeroes the per-interpreter data.
* (We allocate my_cxtp in a Perl SV so that it will be released when
* the interpreter goes away.) */
-#define MY_CXT_INIT \
+# define MY_CXT_INIT \
my_cxt_t *my_cxtp = \
- (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_KEY, sizeof(my_cxt_t))
-#define MY_CXT_INIT_INTERP(my_perl) \
+ (my_cxt_t*)Perl_my_cxt_init(aTHX_ MY_CXT_INIT_ARG, sizeof(my_cxt_t))
+# define MY_CXT_INIT_INTERP(my_perl) \
my_cxt_t *my_cxtp = \
- (my_cxt_t*)Perl_my_cxt_init(my_perl, MY_CXT_KEY, sizeof(my_cxt_t))
+ (my_cxt_t*)Perl_my_cxt_init(my_perl, MY_CXT_INIT_ARG, sizeof(my_cxt_t))
/* This declaration should be used within all functions that use the
* interpreter-local data. */
-#define dMY_CXT \
+# define dMY_CXT \
my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[MY_CXT_INDEX]
-#define dMY_CXT_INTERP(my_perl) \
+# define dMY_CXT_INTERP(my_perl) \
my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[MY_CXT_INDEX]
/* Clones the per-interpreter data. */
-#define MY_CXT_CLONE \
+# define MY_CXT_CLONE \
my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
Copy(PL_my_cxt_list[MY_CXT_INDEX], my_cxtp, 1, my_cxt_t);\
PL_my_cxt_list[MY_CXT_INDEX] = my_cxtp \
-#else /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */
-
-/* This must appear in all extensions that define a my_cxt_t structure,
- * right after the definition (i.e. at file scope). The non-threads
- * case below uses it to declare the data as static. */
-#define START_MY_CXT static int my_cxt_index = -1;
-
-/* This declaration should be used within all functions that use the
- * interpreter-local data. */
-#define dMY_CXT \
- my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[my_cxt_index]
-#define dMY_CXT_INTERP(my_perl) \
- my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[my_cxt_index]
-
-/* Creates and zeroes the per-interpreter data.
- * (We allocate my_cxtp in a Perl SV so that it will be released when
- * the interpreter goes away.) */
-#define MY_CXT_INIT \
- my_cxt_t *my_cxtp = \
- (my_cxt_t*)Perl_my_cxt_init(aTHX_ &my_cxt_index, sizeof(my_cxt_t))
-#define MY_CXT_INIT_INTERP(my_perl) \
- my_cxt_t *my_cxtp = \
- (my_cxt_t*)Perl_my_cxt_init(my_perl, &my_cxt_index, sizeof(my_cxt_t))
-
-/* Clones the per-interpreter data. */
-#define MY_CXT_CLONE \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Copy(PL_my_cxt_list[my_cxt_index], my_cxtp, 1, my_cxt_t);\
- PL_my_cxt_list[my_cxt_index] = my_cxtp \
-
-#endif /* #ifdef PERL_GLOBAL_STRUCT_PRIVATE */
/* This macro must be used to access members of the my_cxt_t structure.
* e.g. MYCXT.some_data */
-#define MY_CXT (*my_cxtp)
+# define MY_CXT (*my_cxtp)
/* Judicious use of these macros can reduce the number of times dMY_CXT
* is used. Use is similar to pTHX, aTHX etc. */
-#define pMY_CXT my_cxt_t *my_cxtp
-#define pMY_CXT_ pMY_CXT,
-#define _pMY_CXT ,pMY_CXT
-#define aMY_CXT my_cxtp
-#define aMY_CXT_ aMY_CXT,
-#define _aMY_CXT ,aMY_CXT
+# define pMY_CXT my_cxt_t *my_cxtp
+# define pMY_CXT_ pMY_CXT,
+# define _pMY_CXT ,pMY_CXT
+# define aMY_CXT my_cxtp
+# define aMY_CXT_ aMY_CXT,
+# define _aMY_CXT ,aMY_CXT
#else /* PERL_IMPLICIT_CONTEXT */
-#define START_MY_CXT static my_cxt_t my_cxt;
-#define dMY_CXT_SV dNOOP
-#define dMY_CXT dNOOP
-#define dMY_CXT_INTERP(my_perl) dNOOP
-#define MY_CXT_INIT NOOP
-#define MY_CXT_CLONE NOOP
-#define MY_CXT my_cxt
-
-#define pMY_CXT void
-#define pMY_CXT_
-#define _pMY_CXT
-#define aMY_CXT
-#define aMY_CXT_
-#define _aMY_CXT
+# define START_MY_CXT static my_cxt_t my_cxt;
+# define dMY_CXT_SV dNOOP
+# define dMY_CXT dNOOP
+# define dMY_CXT_INTERP(my_perl) dNOOP
+# define MY_CXT_INIT NOOP
+# define MY_CXT_CLONE NOOP
+# define MY_CXT my_cxt
+
+# define pMY_CXT void
+# define pMY_CXT_
+# define _pMY_CXT
+# define aMY_CXT
+# define aMY_CXT_
+# define _aMY_CXT
#endif /* !defined(PERL_IMPLICIT_CONTEXT) */
https://perl5.git.perl.org / perl5.git / blobdiff