1/* This file is Based on output from 2 * Perl/Pollution/Portability Version 2.0000 */ 3 4#ifndef _P_P_PORTABILITY_H_ 5#define _P_P_PORTABILITY_H_ 6 7#ifndef PERL_REVISION 8# ifndef __PATCHLEVEL_H_INCLUDED__ 9# include "patchlevel.h" 10# endif 11# ifndef PERL_REVISION 12# define PERL_REVISION (5) 13 /* Replace: 1 */ 14# define PERL_VERSION PATCHLEVEL 15# define PERL_SUBVERSION SUBVERSION 16 /* Replace PERL_PATCHLEVEL with PERL_VERSION */ 17 /* Replace: 0 */ 18# endif 19#endif 20 21#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) 22 23#ifndef ERRSV 24# define ERRSV perl_get_sv("@",FALSE) 25#endif 26 27#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) 28/* Replace: 1 */ 29# define PL_Sv Sv 30# define PL_compiling compiling 31# define PL_copline copline 32# define PL_curcop curcop 33# define PL_curstash curstash 34# define PL_defgv defgv 35# define PL_dirty dirty 36# define PL_hints hints 37# define PL_na na 38# define PL_perldb perldb 39# define PL_rsfp_filters rsfp_filters 40# define PL_rsfp rsfp 41# define PL_stdingv stdingv 42# define PL_sv_no sv_no 43# define PL_sv_undef sv_undef 44# define PL_sv_yes sv_yes 45/* Replace: 0 */ 46#endif 47 48#ifndef pTHX 49# define pTHX 50# define pTHX_ 51# define aTHX 52# define aTHX_ 53#endif 54 55#ifndef PTR2IV 56# define PTR2IV(d) (IV)(d) 57#endif 58 59#ifndef INT2PTR 60# define INT2PTR(any,d) (any)(d) 61#endif 62 63#ifndef dTHR 64# ifdef WIN32 65# define dTHR extern int Perl___notused 66# else 67# define dTHR extern int errno 68# endif 69#endif 70 71#ifndef boolSV 72# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) 73#endif 74 75#ifndef gv_stashpvn 76# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) 77#endif 78 79#ifndef newSVpvn 80# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) 81#endif 82 83#ifndef newRV_inc 84/* Replace: 1 */ 85# define newRV_inc(sv) newRV(sv) 86/* Replace: 0 */ 87#endif 88 89/* DEFSV appears first in 5.004_56 */ 90#ifndef DEFSV 91# define DEFSV GvSV(PL_defgv) 92#endif 93 94#ifndef SAVE_DEFSV 95# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 96#endif 97 98#ifndef newRV_noinc 99# ifdef __GNUC__ 100# define newRV_noinc(sv) \ 101 ({ \ 102 SV *nsv = (SV*)newRV(sv); \ 103 SvREFCNT_dec(sv); \ 104 nsv; \ 105 }) 106# else 107# if defined(CRIPPLED_CC) || defined(USE_THREADS) 108static SV * newRV_noinc (SV * sv) 109{ 110 SV *nsv = (SV*)newRV(sv); 111 SvREFCNT_dec(sv); 112 return nsv; 113} 114# else 115# define newRV_noinc(sv) \ 116 ((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) 117# endif 118# endif 119#endif 120 121/* Provide: newCONSTSUB */ 122 123/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ 124#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) 125 126#if defined(NEED_newCONSTSUB) 127static 128#else 129extern void newCONSTSUB _((HV * stash, char * name, SV *sv)); 130#endif 131 132#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) 133void 134newCONSTSUB(stash,name,sv) 135HV *stash; 136char *name; 137SV *sv; 138{ 139 U32 oldhints = PL_hints; 140 HV *old_cop_stash = PL_curcop->cop_stash; 141 HV *old_curstash = PL_curstash; 142 line_t oldline = PL_curcop->cop_line; 143 PL_curcop->cop_line = PL_copline; 144 145 PL_hints &= ~HINT_BLOCK_SCOPE; 146 if (stash) 147 PL_curstash = PL_curcop->cop_stash = stash; 148 149 newSUB( 150 151#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) 152 /* before 5.003_22 */ 153 start_subparse(), 154#else 155# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) 156 /* 5.003_22 */ 157 start_subparse(0), 158# else 159 /* 5.003_23 onwards */ 160 start_subparse(FALSE, 0), 161# endif 162#endif 163 164 newSVOP(OP_CONST, 0, newSVpv(name,0)), 165 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ 166 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) 167 ); 168 169 PL_hints = oldhints; 170 PL_curcop->cop_stash = old_cop_stash; 171 PL_curstash = old_curstash; 172 PL_curcop->cop_line = oldline; 173} 174#endif 175 176#endif /* newCONSTSUB */ 177 178 179#ifndef START_MY_CXT 180 181/* 182 * Boilerplate macros for initializing and accessing interpreter-local 183 * data from C. All statics in extensions should be reworked to use 184 * this, if you want to make the extension thread-safe. See ext/re/re.xs 185 * for an example of the use of these macros. 186 * 187 * Code that uses these macros is responsible for the following: 188 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" 189 * 2. Declare a typedef named my_cxt_t that is a structure that contains 190 * all the data that needs to be interpreter-local. 191 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. 192 * 4. Use the MY_CXT_INIT macro such that it is called exactly once 193 * (typically put in the BOOT: section). 194 * 5. Use the members of the my_cxt_t structure everywhere as 195 * MY_CXT.member. 196 * 6. Use the dMY_CXT macro (a declaration) in all the functions that 197 * access MY_CXT. 198 */ 199 200#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ 201 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) 202 203/* This must appear in all extensions that define a my_cxt_t structure, 204 * right after the definition (i.e. at file scope). The non-threads 205 * case below uses it to declare the data as static. */ 206#define START_MY_CXT 207 208#if PERL_REVISION == 5 && \ 209 (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) 210/* Fetches the SV that keeps the per-interpreter data. */ 211#define dMY_CXT_SV \ 212 SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) 213#else /* >= perl5.004_68 */ 214#define dMY_CXT_SV \ 215 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ 216 sizeof(MY_CXT_KEY)-1, TRUE) 217#endif /* < perl5.004_68 */ 218 219/* This declaration should be used within all functions that use the 220 * interpreter-local data. */ 221#define dMY_CXT \ 222 dMY_CXT_SV; \ 223 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) 224 225/* Creates and zeroes the per-interpreter data. 226 * (We allocate my_cxtp in a Perl SV so that it will be released when 227 * the interpreter goes away.) */ 228#define MY_CXT_INIT \ 229 dMY_CXT_SV; \ 230 /* newSV() allocates one more than needed */ \ 231 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 232 Zero(my_cxtp, 1, my_cxt_t); \ 233 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 234 235/* This macro must be used to access members of the my_cxt_t structure. 236 * e.g. MYCXT.some_data */ 237#define MY_CXT (*my_cxtp) 238 239/* Judicious use of these macros can reduce the number of times dMY_CXT 240 * is used. Use is similar to pTHX, aTHX etc. */ 241#define pMY_CXT my_cxt_t *my_cxtp 242#define pMY_CXT_ pMY_CXT, 243#define _pMY_CXT ,pMY_CXT 244#define aMY_CXT my_cxtp 245#define aMY_CXT_ aMY_CXT, 246#define _aMY_CXT ,aMY_CXT 247 248#else /* single interpreter */ 249 250#ifndef NOOP 251# define NOOP (void)0 252#endif 253 254#ifdef HASATTRIBUTE 255# define PERL_UNUSED_DECL __attribute__((unused)) 256#else 257# define PERL_UNUSED_DECL 258#endif 259 260#ifndef dNOOP 261# define dNOOP extern int Perl___notused PERL_UNUSED_DECL 262#endif 263 264#define START_MY_CXT static my_cxt_t my_cxt; 265#define dMY_CXT_SV dNOOP 266#define dMY_CXT dNOOP 267#define MY_CXT_INIT NOOP 268#define MY_CXT my_cxt 269 270#define pMY_CXT void 271#define pMY_CXT_ 272#define _pMY_CXT 273#define aMY_CXT 274#define aMY_CXT_ 275#define _aMY_CXT 276 277#endif 278 279#endif /* START_MY_CXT */ 280 281#ifdef SvPVbyte 282# if PERL_REVISION == 5 && PERL_VERSION < 7 283 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ 284# undef SvPVbyte 285# define SvPVbyte(sv, lp) \ 286 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ 287 ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) 288 static char * 289 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) 290 { 291 sv_utf8_downgrade(sv,0); 292 return SvPV(sv,*lp); 293 } 294# endif 295#else 296# define SvPVbyte SvPV 297#endif 298 299#ifndef SvUTF8_off 300# define SvUTF8_off(s) 301#endif 302 303#if 1 304#ifdef DBM_setFilter 305#undef DBM_setFilter 306#undef DBM_ckFilter 307#endif 308#endif 309 310#ifndef DBM_setFilter 311 312/* 313 The DBM_setFilter & DBM_ckFilter macros are only used by 314 the *DB*_File modules 315*/ 316 317#define DBM_setFilter(db_type,code) \ 318 { \ 319 if (db_type) \ 320 RETVAL = sv_mortalcopy(db_type) ; \ 321 ST(0) = RETVAL ; \ 322 if (db_type && (code == &PL_sv_undef)) { \ 323 SvREFCNT_dec(db_type) ; \ 324 db_type = NULL ; \ 325 } \ 326 else if (code) { \ 327 if (db_type) \ 328 sv_setsv(db_type, code) ; \ 329 else \ 330 db_type = newSVsv(code) ; \ 331 } \ 332 } 333 334#define DBM_ckFilter(arg,type,name) \ 335 if (db->type) { \ 336 /*printf("ckFilter %s\n", name);*/ \ 337 if (db->filtering) { \ 338 croak("recursion detected in %s", name) ; \ 339 } \ 340 ENTER ; \ 341 SAVETMPS ; \ 342 SAVEINT(db->filtering) ; \ 343 db->filtering = TRUE ; \ 344 SAVESPTR(DEFSV) ; \ 345 if (name[7] == 's') \ 346 arg = newSVsv(arg); \ 347 DEFSV = arg ; \ 348 SvTEMP_off(arg) ; \ 349 PUSHMARK(SP) ; \ 350 PUTBACK ; \ 351 (void) perl_call_sv(db->type, G_DISCARD); \ 352 SPAGAIN ; \ 353 PUTBACK ; \ 354 FREETMPS ; \ 355 LEAVE ; \ 356 if (name[7] == 's'){ \ 357 arg = sv_2mortal(arg); \ 358 } \ 359 SvOKp(arg); \ 360 } 361 362#endif /* DBM_setFilter */ 363 364#endif /* _P_P_PORTABILITY_H_ */ 365