/* perl.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
# endif
#endif
-#if defined(MULTIPLICITY)
-# ifndef PERL_IMPLICIT_CONTEXT
-# define PERL_IMPLICIT_CONTEXT
-# endif
-#endif
-
#ifdef PERL_GLOBAL_STRUCT_PRIVATE
# ifndef PERL_GLOBAL_STRUCT
# define PERL_GLOBAL_STRUCT
# endif
#endif
+
#ifdef PERL_GLOBAL_STRUCT
# ifndef MULTIPLICITY
# define MULTIPLICITY
# endif
#endif
+#ifdef MULTIPLICITY
+# ifndef PERL_IMPLICIT_CONTEXT
+# define PERL_IMPLICIT_CONTEXT
+# endif
+#endif
+
/* undef WIN32 when building on Cygwin (for libwin32) - gph */
#ifdef __CYGWIN__
# undef WIN32
# define MULTIPLICITY
# endif
# define tTHX PerlInterpreter*
-# define sTHX (sizeof(tTHX) + (MEM_ALIGNBYTES - sizeof(tTHX)%MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
# define pTHX register tTHX my_perl PERL_UNUSED_DECL
# define aTHX my_perl
# ifdef PERL_GLOBAL_STRUCT
# define STATUS_NATIVE PL_statusvalue_vms
/*
* vaxc$errno is only guaranteed to be valid if errno == EVMSERR, otherwise
- * it's contents can not be trusted. Unfortunately, Perl seems to check
+ * its contents can not be trusted. Unfortunately, Perl seems to check
* it on exit, so it when PL_statusvalue_vms is updated, vaxc$errno should
* be updated also.
*/
# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK)
# else
# if defined(_IOC_SIZE) && defined(__GLIBC__)
- /* on Linux systems we're safe */
-# define IOCPARM_LEN(x) _IOC_SIZE(x)
+ /* on Linux systems we're safe; except when we're not [perl #38223] */
+# define IOCPARM_LEN(x) (_IOC_SIZE(x) < 256 ? 256 : _IOC_SIZE(x))
# else
/* otherwise guess at what's safe */
# define IOCPARM_LEN(x) 256
#ifndef assert /* <assert.h> might have been included somehow */
#define assert(what) PERL_DEB( \
((what) ? ((void) 0) : \
- (Perl_croak(aTHX_ "Assertion %s failed: file \"" __FILE__ \
+ (Perl_croak_nocontext("Assertion %s failed: file \"" __FILE__ \
"\", line %d", STRINGIFY(what), __LINE__), \
PerlProc_exit(1), \
(void) 0)))
# define MALLOC_TERM
#endif
+#if defined(PERL_IMPLICIT_CONTEXT)
+struct perl_memory_debug_header {
+ tTHX interpreter;
+# ifdef PERL_POISON
+ MEM_SIZE size;
+ U8 in_use;
+# endif
+
+#define PERL_POISON_INUSE 29
+#define PERL_POISON_FREE 159
+};
+
+# define sTHX (sizeof(struct perl_memory_debug_header) + \
+ (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
+ %MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
+
+#endif
+
typedef int (CPERLscope(*runops_proc_t)) (pTHX);
typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv);
"LOOP",
"SUBST",
"BLOCK",
+ "FORMAT",
+ "GIVEN",
+ "WHEN"
};
#else
EXTCONST char* PL_block_type[];
START_EXTERN_C
#ifdef DOINIT
-# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {a,b,c,d,e,f,g}
-# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var = {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g} /* Like MGVTBL_SET but with the get magic having a const MG* */
+# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXT MGVTBL var = {a,b,c,d,e,f,g}
+# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXT MGVTBL var = {(int (*)(pTHX_ SV *, MAGIC *))a,b,c,d,e,f,g} /* Like MGVTBL_SET but with the get magic having a const MG* */
#else
-# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var
-# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXTCONST MGVTBL var
+# define MGVTBL_SET(var,a,b,c,d,e,f,g) EXT MGVTBL var
+# define MGVTBL_SET_CONST_MAGIC_GET(var,a,b,c,d,e,f,g) EXT MGVTBL var
#endif
MGVTBL_SET(
to_sv_amg, to_av_amg,
to_hv_amg, to_gv_amg,
to_cv_amg, iter_amg,
- int_amg, DESTROY_amg,
+ int_amg, smart_amg,
+
+ /* Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry */
+ DESTROY_amg,
max_amg_code
/* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
};
"(${}", "(@{}",
"(%{}", "(*{}",
"(&{}", "(<>",
- "(int", "DESTROY",
+ "(int", "(~~",
+ "DESTROY"
};
#else
EXTCONST char * PL_AMG_names[NofAMmeth];
* Code that uses these macros is responsible for the following:
* 1. #define MY_CXT_KEY to a unique string, e.g.
* "DynaLoader::_guts" XS_VERSION
+ * XXX in the current implementation, this string is ignored.
* 2. Declare a typedef named my_cxt_t that is a structure that contains
* all the data that needs to be interpreter-local.
* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
/* 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
-
-/* Fetches the SV that keeps the per-interpreter data. */
-#define dMY_CXT_SV \
- SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
- sizeof(MY_CXT_KEY)-1, TRUE)
+#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 \
- dMY_CXT_SV; \
- my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*, SvUV(my_cxt_sv))
+ 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 \
- dMY_CXT_SV; \
- /* newSV() allocates one more than needed */ \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Zero(my_cxtp, 1, my_cxt_t); \
- sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+ 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 \
- dMY_CXT_SV; \
my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
- sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+ Copy(PL_my_cxt_list[my_cxt_index], my_cxtp, 1, my_cxt_t);\
+ PL_my_cxt_list[my_cxt_index] = my_cxtp \
/* This macro must be used to access members of the my_cxt_t structure.
* e.g. MYCXT.some_data */
#define aMY_CXT_ aMY_CXT,
#define _aMY_CXT ,aMY_CXT
-#else /* USE_ITHREADS */
+#else /* PERL_IMPLICIT_CONTEXT */
#define START_MY_CXT static my_cxt_t my_cxt;
#define dMY_CXT_SV dNOOP
#define aMY_CXT_
#define _aMY_CXT
-#endif /* !defined(USE_ITHREADS) */
+#endif /* !defined(PERL_IMPLICIT_CONTEXT) */
#ifdef I_FCNTL
# include <fcntl.h>
projects / p5sagit/p5-mst-13.2.git / blobdiff