00001
00002
00003
00004 #ifndef _P_P_PORTABILITY_H_
00005 #define _P_P_PORTABILITY_H_
00006
00007 #ifndef PERL_REVISION
00008 # ifndef __PATCHLEVEL_H_INCLUDED__
00009 # include "patchlevel.h"
00010 # endif
00011 # ifndef PERL_REVISION
00012 # define PERL_REVISION (5)
00013
00014 # define PERL_VERSION PATCHLEVEL
00015 # define PERL_SUBVERSION SUBVERSION
00016
00017
00018 # endif
00019 #endif
00020
00021 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
00022
00023 #ifndef ERRSV
00024 # define ERRSV perl_get_sv("@",FALSE)
#endif
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
/* Replace: 1 */
# define PL_Sv Sv
# define PL_compiling compiling
# define PL_copline copline
# define PL_curcop curcop
# define PL_curstash curstash
# define PL_defgv defgv
# define PL_dirty dirty
# define PL_hints hints
# define PL_na na
# define PL_perldb perldb
# define PL_rsfp_filters rsfp_filters
# define PL_rsfp rsfp
# define PL_stdingv stdingv
# define PL_sv_no sv_no
# define PL_sv_undef sv_undef
# define PL_sv_yes sv_yes
/* Replace: 0 */
#endif
#ifndef pTHX
# define pTHX
# define pTHX_
# define aTHX
# define aTHX_
#endif
#ifndef PTR2IV
# define PTR2IV(d) (IV)(d)
#endif
#ifndef INT2PTR
# define INT2PTR(any,d) (any)(d)
#endif
#ifndef dTHR
# ifdef WIN32
# define dTHR extern int Perl___notused
# else
# define dTHR extern int errno
# endif
#endif
#ifndef boolSV
# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#endif
#ifndef gv_stashpvn
# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
#endif
#ifndef newSVpvn
# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
#endif
#ifndef newRV_inc
/* Replace: 1 */
# define newRV_inc(sv) newRV(sv)
/* Replace: 0 */
#endif
#ifndef SvGETMAGIC
# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
#endif
/* DEFSV appears first in 5.004_56 */
#ifndef DEFSV
# define DEFSV GvSV(PL_defgv)
#endif
#ifndef SAVE_DEFSV
# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#endif
#ifndef newRV_noinc
# ifdef __GNUC__
# define newRV_noinc(sv) \
({ \
SV *nsv = (SV*)newRV(sv); \
SvREFCNT_dec(sv); \
nsv; \
})
# else
# if defined(CRIPPLED_CC) || defined(USE_THREADS)
static SV * newRV_noinc (SV * sv)
{
SV *nsv = (SV*)newRV(sv);
SvREFCNT_dec(sv);
return nsv;
}
# else
# define newRV_noinc(sv) \
((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
# endif
# endif
#endif
/* Provide: newCONSTSUB */
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
#if defined(NEED_newCONSTSUB)
static
#else
extern void newCONSTSUB _((HV * stash, char * name, SV *sv));
#endif
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
void
newCONSTSUB(stash,name,sv)
HV *stash;
char *name;
SV *sv;
{
U32 oldhints = PL_hints;
HV *old_cop_stash = PL_curcop->cop_stash;
HV *old_curstash = PL_curstash;
line_t oldline = PL_curcop->cop_line;
PL_curcop->cop_line = PL_copline;
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash)
PL_curstash = PL_curcop->cop_stash = stash;
newSUB(
#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
/* before 5.003_22 */
start_subparse(),
#else
# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
/* 5.003_22 */
start_subparse(0),
# else
/* 5.003_23 onwards */
start_subparse(FALSE, 0),
# endif
#endif
newSVOP(OP_CONST, 0, newSVpv(name,0)),
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
);
PL_hints = oldhints;
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
PL_curcop->cop_line = oldline;
}
#endif
#endif /* newCONSTSUB */
#ifndef START_MY_CXT
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
* this, if you want to make the extension thread-safe. See ext/re/re.xs
* for an example of the use of these macros.
*
* Code that uses these macros is responsible for the following:
* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
00025 * 2. Declare a typedef named my_cxt_t that is a structure that contains
00026 * all the data that needs to be interpreter-local.
00027 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
00028 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
00029 * (typically put in the BOOT: section).
00030 * 5. Use the members of the my_cxt_t structure everywhere as
00031 * MY_CXT.member.
00032 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
00033 * access MY_CXT.
00034 */
00035
00036 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
00037 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
00038
00039
00040
00041
00042 #define START_MY_CXT
00043
00044 #if PERL_REVISION == 5 && \
00045 (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
00046
00047 #define dMY_CXT_SV \
00048 SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
00049 #else
00050 #define dMY_CXT_SV \
00051 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
00052 sizeof(MY_CXT_KEY)-1, TRUE)
00053 #endif
00054
00055
00056
00057 #define dMY_CXT \
00058 dMY_CXT_SV; \
00059 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
00060
00061
00062
00063
00064 #define MY_CXT_INIT \
00065 dMY_CXT_SV; \
00066 \
00067 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
00068 Zero(my_cxtp, 1, my_cxt_t); \
00069 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
00070
00071
00072
00073 #define MY_CXT (*my_cxtp)
00074
00075
00076
00077 #define pMY_CXT my_cxt_t *my_cxtp
00078 #define pMY_CXT_ pMY_CXT,
00079 #define _pMY_CXT ,pMY_CXT
00080 #define aMY_CXT my_cxtp
00081 #define aMY_CXT_ aMY_CXT,
00082 #define _aMY_CXT ,aMY_CXT
00083
00084 #else
00085
00086 #ifndef NOOP
00087 # define NOOP (void)0
00088 #endif
00089
00090 #ifdef HASATTRIBUTE
00091 # define PERL_UNUSED_DECL __attribute__((unused))
00092 #else
00093 # define PERL_UNUSED_DECL
00094 #endif
00095
00096 #ifndef dNOOP
00097 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL
00098 #endif
00099
00100 #define START_MY_CXT static my_cxt_t my_cxt;
00101 #define dMY_CXT_SV dNOOP
00102 #define dMY_CXT dNOOP
00103 #define MY_CXT_INIT NOOP
00104 #define MY_CXT my_cxt
00105
00106 #define pMY_CXT void
00107 #define pMY_CXT_
00108 #define _pMY_CXT
00109 #define aMY_CXT
00110 #define aMY_CXT_
00111 #define _aMY_CXT
00112
00113 #endif
00114
00115 #endif
00116
00117
00118 #if 1
00119 #ifdef DBM_setFilter
00120 #undef DBM_setFilter
00121 #undef DBM_ckFilter
00122 #endif
00123 #endif
00124
00125 #ifndef DBM_setFilter
00126
00127
00128
00129
00130
00131
00132 #define DBM_setFilter(db_type,code) \
00133 { \
00134 if (db_type) \
00135 RETVAL = sv_mortalcopy(db_type) ; \
00136 ST(0) = RETVAL ; \
00137 if (db_type && (code == &PL_sv_undef)) { \
00138 SvREFCNT_dec(db_type) ; \
00139 db_type = NULL ; \
00140 } \
00141 else if (code) { \
00142 if (db_type) \
00143 sv_setsv(db_type, code) ; \
00144 else \
00145 db_type = newSVsv(code) ; \
00146 } \
00147 }
00148
00149 #define DBM_ckFilter(arg,type,name) \
00150 if (db->type) { \
00151 \
00152 if (db->filtering) { \
00153 croak("recursion detected in %s", name) ; \
00154 } \
00155 ENTER ; \
00156 SAVETMPS ; \
00157 SAVEINT(db->filtering) ; \
00158 db->filtering = TRUE ; \
00159 SAVESPTR(DEFSV) ; \
00160 if (name[7] == 's') \
00161 arg = newSVsv(arg); \
00162 DEFSV = arg ; \
00163 SvTEMP_off(arg) ; \
00164 PUSHMARK(SP) ; \
00165 PUTBACK ; \
00166 (void) perl_call_sv(db->type, G_DISCARD); \
00167 arg = DEFSV ; \
00168 SPAGAIN ; \
00169 PUTBACK ; \
00170 FREETMPS ; \
00171 LEAVE ; \
00172 if (name[7] == 's'){ \
00173 arg = sv_2mortal(arg); \
00174 } \
00175 SvOKp(arg); \
00176 }
00177
00178 #endif
00179
00180 #endif
00181 