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#ifndef SvGETMAGIC 90# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END 91#endif 92 93 94/* DEFSV appears first in 5.004_56 */ 95#ifndef DEFSV 96# define DEFSV GvSV(PL_defgv) 97#endif 98 99#ifndef SAVE_DEFSV 100# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 101#endif 102 103#ifndef newRV_noinc 104# ifdef __GNUC__ 105# define newRV_noinc(sv) \ 106 ({ \ 107 SV *nsv = (SV*)newRV(sv); \ 108 SvREFCNT_dec(sv); \ 109 nsv; \ 110 }) 111# else 112# if defined(CRIPPLED_CC) || defined(USE_THREADS) 113static SV * newRV_noinc (SV * sv) 114{ 115 SV *nsv = (SV*)newRV(sv); 116 SvREFCNT_dec(sv); 117 return nsv; 118} 119# else 120# define newRV_noinc(sv) \ 121 ((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) 122# endif 123# endif 124#endif 125 126/* Provide: newCONSTSUB */ 127 128/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ 129#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) 130 131#if defined(NEED_newCONSTSUB) 132static 133#else 134extern void newCONSTSUB _((HV * stash, char * name, SV *sv)); 135#endif 136 137#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) 138void 139newCONSTSUB(stash,name,sv) 140HV *stash; 141char *name; 142SV *sv; 143{ 144 U32 oldhints = PL_hints; 145 HV *old_cop_stash = PL_curcop->cop_stash; 146 HV *old_curstash = PL_curstash; 147 line_t oldline = PL_curcop->cop_line; 148 PL_curcop->cop_line = PL_copline; 149 150 PL_hints &= ~HINT_BLOCK_SCOPE; 151 if (stash) 152 PL_curstash = PL_curcop->cop_stash = stash; 153 154 newSUB( 155 156#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) 157 /* before 5.003_22 */ 158 start_subparse(), 159#else 160# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) 161 /* 5.003_22 */ 162 start_subparse(0), 163# else 164 /* 5.003_23 onwards */ 165 start_subparse(FALSE, 0), 166# endif 167#endif 168 169 newSVOP(OP_CONST, 0, newSVpv(name,0)), 170 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ 171 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) 172 ); 173 174 PL_hints = oldhints; 175 PL_curcop->cop_stash = old_cop_stash; 176 PL_curstash = old_curstash; 177 PL_curcop->cop_line = oldline; 178} 179#endif 180 181#endif /* newCONSTSUB */ 182 183 184#ifndef START_MY_CXT 185 186/* 187 * Boilerplate macros for initializing and accessing interpreter-local 188 * data from C. All statics in extensions should be reworked to use 189 * this, if you want to make the extension thread-safe. See ext/re/re.xs 190 * for an example of the use of these macros. 191 * 192 * Code that uses these macros is responsible for the following: 193 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" 194 * 2. Declare a typedef named my_cxt_t that is a structure that contains 195 * all the data that needs to be interpreter-local. 196 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. 197 * 4. Use the MY_CXT_INIT macro such that it is called exactly once 198 * (typically put in the BOOT: section). 199 * 5. Use the members of the my_cxt_t structure everywhere as 200 * MY_CXT.member. 201 * 6. Use the dMY_CXT macro (a declaration) in all the functions that 202 * access MY_CXT. 203 */ 204 205#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ 206 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) 207 208/* This must appear in all extensions that define a my_cxt_t structure, 209 * right after the definition (i.e. at file scope). The non-threads 210 * case below uses it to declare the data as static. */ 211#define START_MY_CXT 212 213#if PERL_REVISION == 5 && \ 214 (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) 215/* Fetches the SV that keeps the per-interpreter data. */ 216#define dMY_CXT_SV \ 217 SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) 218#else /* >= perl5.004_68 */ 219#define dMY_CXT_SV \ 220 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ 221 sizeof(MY_CXT_KEY)-1, TRUE) 222#endif /* < perl5.004_68 */ 223 224/* This declaration should be used within all functions that use the 225 * interpreter-local data. */ 226#define dMY_CXT \ 227 dMY_CXT_SV; \ 228 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) 229 230/* Creates and zeroes the per-interpreter data. 231 * (We allocate my_cxtp in a Perl SV so that it will be released when 232 * the interpreter goes away.) */ 233#define MY_CXT_INIT \ 234 dMY_CXT_SV; \ 235 /* newSV() allocates one more than needed */ \ 236 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 237 Zero(my_cxtp, 1, my_cxt_t); \ 238 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 239 240/* This macro must be used to access members of the my_cxt_t structure. 241 * e.g. MYCXT.some_data */ 242#define MY_CXT (*my_cxtp) 243 244/* Judicious use of these macros can reduce the number of times dMY_CXT 245 * is used. Use is similar to pTHX, aTHX etc. */ 246#define pMY_CXT my_cxt_t *my_cxtp 247#define pMY_CXT_ pMY_CXT, 248#define _pMY_CXT ,pMY_CXT 249#define aMY_CXT my_cxtp 250#define aMY_CXT_ aMY_CXT, 251#define _aMY_CXT ,aMY_CXT 252 253#else /* single interpreter */ 254 255#ifndef NOOP 256# define NOOP (void)0 257#endif 258 259#ifdef HASATTRIBUTE 260# define PERL_UNUSED_DECL __attribute__((unused)) 261#else 262# define PERL_UNUSED_DECL 263#endif 264 265#ifndef dNOOP 266# define dNOOP extern int Perl___notused PERL_UNUSED_DECL 267#endif 268 269#define START_MY_CXT static my_cxt_t my_cxt; 270#define dMY_CXT_SV dNOOP 271#define dMY_CXT dNOOP 272#define MY_CXT_INIT NOOP 273#define MY_CXT my_cxt 274 275#define pMY_CXT void 276#define pMY_CXT_ 277#define _pMY_CXT 278#define aMY_CXT 279#define aMY_CXT_ 280#define _aMY_CXT 281 282#endif 283 284#endif /* START_MY_CXT */ 285 286 287#if 1 288#ifdef DBM_setFilter 289#undef DBM_setFilter 290#undef DBM_ckFilter 291#endif 292#endif 293 294#ifndef DBM_setFilter 295 296/* 297 The DBM_setFilter & DBM_ckFilter macros are only used by 298 the *DB*_File modules 299*/ 300 301#define DBM_setFilter(db_type,code) \ 302 { \ 303 if (db_type) \ 304 RETVAL = sv_mortalcopy(db_type) ; \ 305 ST(0) = RETVAL ; \ 306 if (db_type && (code == &PL_sv_undef)) { \ 307 SvREFCNT_dec(db_type) ; \ 308 db_type = NULL ; \ 309 } \ 310 else if (code) { \ 311 if (db_type) \ 312 sv_setsv(db_type, code) ; \ 313 else \ 314 db_type = newSVsv(code) ; \ 315 } \ 316 } 317 318#define DBM_ckFilter(arg,type,name) \ 319 if (db->type) { \ 320 /* printf("Filtering %s\n", name); */ \ 321 if (db->filtering) { \ 322 croak("recursion detected in %s", name) ; \ 323 } \ 324 ENTER ; \ 325 SAVETMPS ; \ 326 SAVEINT(db->filtering) ; \ 327 db->filtering = TRUE ; \ 328 SAVESPTR(DEFSV) ; \ 329 if (name[7] == 's') \ 330 arg = newSVsv(arg); \ 331 DEFSV = arg ; \ 332 SvTEMP_off(arg) ; \ 333 PUSHMARK(SP) ; \ 334 PUTBACK ; \ 335 (void) perl_call_sv(db->type, G_DISCARD); \ 336 arg = DEFSV ; \ 337 SPAGAIN ; \ 338 PUTBACK ; \ 339 FREETMPS ; \ 340 LEAVE ; \ 341 if (name[7] == 's'){ \ 342 arg = sv_2mortal(arg); \ 343 } \ 344 SvOKp(arg); \ 345 } 346 347#endif /* DBM_setFilter */ 348 349#endif /* _P_P_PORTABILITY_H_ */ 350