1 2/* ppport.h -- Perl/Pollution/Portability Version 2.003 3 * 4 * Automatically Created by Devel::PPPort on Tue Jan 11 21:00:54 2005 5 * 6 * Do NOT edit this file directly! -- Edit PPPort.pm instead. 7 * 8 * Version 2.x, Copyright (C) 2001, Paul Marquess. 9 * Version 1.x, Copyright (C) 1999, Kenneth Albanowski. 10 * This code may be used and distributed under the same license as any 11 * version of Perl. 12 * 13 * This version of ppport.h is designed to support operation with Perl 14 * installations back to 5.004, and has been tested up to 5.8.0. 15 * 16 * If this version of ppport.h is failing during the compilation of this 17 * module, please check if a newer version of Devel::PPPort is available 18 * on CPAN before sending a bug report. 19 * 20 * If you are using the latest version of Devel::PPPort and it is failing 21 * during compilation of this module, please send a report to perlbug@perl.com 22 * 23 * Include all following information: 24 * 25 * 1. The complete output from running "perl -V" 26 * 27 * 2. This file. 28 * 29 * 3. The name & version of the module you were trying to build. 30 * 31 * 4. A full log of the build that failed. 32 * 33 * 5. Any other information that you think could be relevant. 34 * 35 * 36 * For the latest version of this code, please retreive the Devel::PPPort 37 * module from CPAN. 38 * 39 */ 40 41/* 42 * In order for a Perl extension module to be as portable as possible 43 * across differing versions of Perl itself, certain steps need to be taken. 44 * Including this header is the first major one, then using dTHR is all the 45 * appropriate places and using a PL_ prefix to refer to global Perl 46 * variables is the second. 47 * 48 */ 49 50 51/* If you use one of a few functions that were not present in earlier 52 * versions of Perl, please add a define before the inclusion of ppport.h 53 * for a static include, or use the GLOBAL request in a single module to 54 * produce a global definition that can be referenced from the other 55 * modules. 56 * 57 * Function: Static define: Extern define: 58 * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL 59 * 60 */ 61 62 63/* To verify whether ppport.h is needed for your module, and whether any 64 * special defines should be used, ppport.h can be run through Perl to check 65 * your source code. Simply say: 66 * 67 * perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc] 68 * 69 * The result will be a list of patches suggesting changes that should at 70 * least be acceptable, if not necessarily the most efficient solution, or a 71 * fix for all possible problems. It won't catch where dTHR is needed, and 72 * doesn't attempt to account for global macro or function definitions, 73 * nested includes, typemaps, etc. 74 * 75 * In order to test for the need of dTHR, please try your module under a 76 * recent version of Perl that has threading compiled-in. 77 * 78 */ 79 80 81/* 82#!/usr/bin/perl 83@ARGV = ("*.xs") if !@ARGV; 84%badmacros = %funcs = %macros = (); $replace = 0; 85foreach (<DATA>) { 86 $funcs{$1} = 1 if /Provide:\s+(\S+)/; 87 $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/; 88 $replace = $1 if /Replace:\s+(\d+)/; 89 $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/; 90 $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/; 91} 92foreach $filename (map(glob($_),@ARGV)) { 93 unless (open(IN, "<$filename")) { 94 warn "Unable to read from $file: $!\n"; 95 next; 96 } 97 print "Scanning $filename...\n"; 98 $c = ""; while (<IN>) { $c .= $_; } close(IN); 99 $need_include = 0; %add_func = (); $changes = 0; 100 $has_include = ($c =~ /#.*include.*ppport/m); 101 102 foreach $func (keys %funcs) { 103 if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) { 104 if ($c !~ /\b$func\b/m) { 105 print "If $func isn't needed, you don't need to request it.\n" if 106 $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m); 107 } else { 108 print "Uses $func\n"; 109 $need_include = 1; 110 } 111 } else { 112 if ($c =~ /\b$func\b/m) { 113 $add_func{$func} =1 ; 114 print "Uses $func\n"; 115 $need_include = 1; 116 } 117 } 118 } 119 120 if (not $need_include) { 121 foreach $macro (keys %macros) { 122 if ($c =~ /\b$macro\b/m) { 123 print "Uses $macro\n"; 124 $need_include = 1; 125 } 126 } 127 } 128 129 foreach $badmacro (keys %badmacros) { 130 if ($c =~ /\b$badmacro\b/m) { 131 $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm); 132 print "Uses $badmacros{$badmacro} (instead of $badmacro)\n"; 133 $need_include = 1; 134 } 135 } 136 137 if (scalar(keys %add_func) or $need_include != $has_include) { 138 if (!$has_include) { 139 $inc = join('',map("#define NEED_$_\n", sort keys %add_func)). 140 "#include \"ppport.h\"\n"; 141 $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m; 142 } elsif (keys %add_func) { 143 $inc = join('',map("#define NEED_$_\n", sort keys %add_func)); 144 $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m; 145 } 146 if (!$need_include) { 147 print "Doesn't seem to need ppport.h.\n"; 148 $c =~ s/^.*#.*include.*ppport.*\n//m; 149 } 150 $changes++; 151 } 152 153 if ($changes) { 154 open(OUT,">/tmp/ppport.h.$$"); 155 print OUT $c; 156 close(OUT); 157 open(DIFF, "diff -u $filename /tmp/ppport.h.$$|"); 158 while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; } 159 close(DIFF); 160 unlink("/tmp/ppport.h.$$"); 161 } else { 162 print "Looks OK\n"; 163 } 164} 165__DATA__ 166*/ 167 168#ifndef _P_P_PORTABILITY_H_ 169#define _P_P_PORTABILITY_H_ 170 171#ifndef PERL_REVISION 172# ifndef __PATCHLEVEL_H_INCLUDED__ 173# include <patchlevel.h> 174# endif 175# if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL))) 176# include <could_not_find_Perl_patchlevel.h> 177# endif 178# ifndef PERL_REVISION 179# define PERL_REVISION (5) 180 /* Replace: 1 */ 181# define PERL_VERSION PATCHLEVEL 182# define PERL_SUBVERSION SUBVERSION 183 /* Replace PERL_PATCHLEVEL with PERL_VERSION */ 184 /* Replace: 0 */ 185# endif 186#endif 187 188#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) 189 190/* It is very unlikely that anyone will try to use this with Perl 6 191 (or greater), but who knows. 192 */ 193#if PERL_REVISION != 5 194# error ppport.h only works with Perl version 5 195#endif /* PERL_REVISION != 5 */ 196 197#ifndef ERRSV 198# define ERRSV perl_get_sv("@",FALSE) 199#endif 200 201#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) 202/* Replace: 1 */ 203# define PL_Sv Sv 204# define PL_compiling compiling 205# define PL_copline copline 206# define PL_curcop curcop 207# define PL_curstash curstash 208# define PL_defgv defgv 209# define PL_dirty dirty 210# define PL_dowarn dowarn 211# define PL_hints hints 212# define PL_na na 213# define PL_perldb perldb 214# define PL_rsfp_filters rsfp_filters 215# define PL_rsfpv rsfp 216# define PL_stdingv stdingv 217# define PL_sv_no sv_no 218# define PL_sv_undef sv_undef 219# define PL_sv_yes sv_yes 220/* Replace: 0 */ 221#endif 222 223#ifdef HASATTRIBUTE 224# if defined(__GNUC__) && defined(__cplusplus) 225# define PERL_UNUSED_DECL 226# else 227# define PERL_UNUSED_DECL __attribute__((unused)) 228# endif 229#else 230# define PERL_UNUSED_DECL 231#endif 232 233#ifndef dNOOP 234# define NOOP (void)0 235# define dNOOP extern int Perl___notused PERL_UNUSED_DECL 236#endif 237 238#ifndef dTHR 239# define dTHR dNOOP 240#endif 241 242#ifndef dTHX 243# define dTHX dNOOP 244# define dTHXa(x) dNOOP 245# define dTHXoa(x) dNOOP 246#endif 247 248#ifndef pTHX 249# define pTHX void 250# define pTHX_ 251# define aTHX 252# define aTHX_ 253#endif 254 255/* IV could also be a quad (say, a long long), but Perls 256 * capable of those should have IVSIZE already. */ 257#if !defined(IVSIZE) && defined(LONGSIZE) 258# define IVSIZE LONGSIZE 259#endif 260#ifndef IVSIZE 261# define IVSIZE 4 /* A bold guess, but the best we can make. */ 262#endif 263 264#ifndef UVSIZE 265# define UVSIZE IVSIZE 266#endif 267 268#ifndef NVTYPE 269# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) 270# define NVTYPE long double 271# else 272# define NVTYPE double 273# endif 274typedef NVTYPE NV; 275#endif 276 277#ifndef INT2PTR 278 279#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) 280# define PTRV UV 281# define INT2PTR(any,d) (any)(d) 282#else 283# if PTRSIZE == LONGSIZE 284# define PTRV unsigned long 285# else 286# define PTRV unsigned 287# endif 288# define INT2PTR(any,d) (any)(PTRV)(d) 289#endif 290#define NUM2PTR(any,d) (any)(PTRV)(d) 291#define PTR2IV(p) INT2PTR(IV,p) 292#define PTR2UV(p) INT2PTR(UV,p) 293#define PTR2NV(p) NUM2PTR(NV,p) 294#if PTRSIZE == LONGSIZE 295# define PTR2ul(p) (unsigned long)(p) 296#else 297# define PTR2ul(p) INT2PTR(unsigned long,p) 298#endif 299 300#endif /* !INT2PTR */ 301 302#ifndef boolSV 303# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) 304#endif 305 306#ifndef gv_stashpvn 307# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) 308#endif 309 310#ifndef newSVpvn 311# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) 312#endif 313 314#ifndef newRV_inc 315/* Replace: 1 */ 316# define newRV_inc(sv) newRV(sv) 317/* Replace: 0 */ 318#endif 319 320/* DEFSV appears first in 5.004_56 */ 321#ifndef DEFSV 322# define DEFSV GvSV(PL_defgv) 323#endif 324 325#ifndef SAVE_DEFSV 326# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 327#endif 328 329#ifndef newRV_noinc 330# ifdef __GNUC__ 331# define newRV_noinc(sv) \ 332 ({ \ 333 SV *nsv = (SV*)newRV(sv); \ 334 SvREFCNT_dec(sv); \ 335 nsv; \ 336 }) 337# else 338# if defined(USE_THREADS) 339static SV * newRV_noinc (SV * sv) 340{ 341 SV *nsv = (SV*)newRV(sv); 342 SvREFCNT_dec(sv); 343 return nsv; 344} 345# else 346# define newRV_noinc(sv) \ 347 (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) 348# endif 349# endif 350#endif 351 352/* Provide: newCONSTSUB */ 353 354/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ 355#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) 356 357#if defined(NEED_newCONSTSUB) 358static 359#else 360extern void newCONSTSUB(HV * stash, char * name, SV *sv); 361#endif 362 363#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) 364void 365newCONSTSUB(stash,name,sv) 366HV *stash; 367char *name; 368SV *sv; 369{ 370 U32 oldhints = PL_hints; 371 HV *old_cop_stash = PL_curcop->cop_stash; 372 HV *old_curstash = PL_curstash; 373 line_t oldline = PL_curcop->cop_line; 374 PL_curcop->cop_line = PL_copline; 375 376 PL_hints &= ~HINT_BLOCK_SCOPE; 377 if (stash) 378 PL_curstash = PL_curcop->cop_stash = stash; 379 380 newSUB( 381 382#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) 383 /* before 5.003_22 */ 384 start_subparse(), 385#else 386# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) 387 /* 5.003_22 */ 388 start_subparse(0), 389# else 390 /* 5.003_23 onwards */ 391 start_subparse(FALSE, 0), 392# endif 393#endif 394 395 newSVOP(OP_CONST, 0, newSVpv(name,0)), 396 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ 397 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) 398 ); 399 400 PL_hints = oldhints; 401 PL_curcop->cop_stash = old_cop_stash; 402 PL_curstash = old_curstash; 403 PL_curcop->cop_line = oldline; 404} 405#endif 406 407#endif /* newCONSTSUB */ 408 409#ifndef START_MY_CXT 410 411/* 412 * Boilerplate macros for initializing and accessing interpreter-local 413 * data from C. All statics in extensions should be reworked to use 414 * this, if you want to make the extension thread-safe. See ext/re/re.xs 415 * for an example of the use of these macros. 416 * 417 * Code that uses these macros is responsible for the following: 418 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" 419 * 2. Declare a typedef named my_cxt_t that is a structure that contains 420 * all the data that needs to be interpreter-local. 421 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. 422 * 4. Use the MY_CXT_INIT macro such that it is called exactly once 423 * (typically put in the BOOT: section). 424 * 5. Use the members of the my_cxt_t structure everywhere as 425 * MY_CXT.member. 426 * 6. Use the dMY_CXT macro (a declaration) in all the functions that 427 * access MY_CXT. 428 */ 429 430#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ 431 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) 432 433/* This must appear in all extensions that define a my_cxt_t structure, 434 * right after the definition (i.e. at file scope). The non-threads 435 * case below uses it to declare the data as static. */ 436#define START_MY_CXT 437 438#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) 439/* Fetches the SV that keeps the per-interpreter data. */ 440#define dMY_CXT_SV \ 441 SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) 442#else /* >= perl5.004_68 */ 443#define dMY_CXT_SV \ 444 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ 445 sizeof(MY_CXT_KEY)-1, TRUE) 446#endif /* < perl5.004_68 */ 447 448/* This declaration should be used within all functions that use the 449 * interpreter-local data. */ 450#define dMY_CXT \ 451 dMY_CXT_SV; \ 452 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) 453 454/* Creates and zeroes the per-interpreter data. 455 * (We allocate my_cxtp in a Perl SV so that it will be released when 456 * the interpreter goes away.) */ 457#define MY_CXT_INIT \ 458 dMY_CXT_SV; \ 459 /* newSV() allocates one more than needed */ \ 460 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 461 Zero(my_cxtp, 1, my_cxt_t); \ 462 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 463 464/* This macro must be used to access members of the my_cxt_t structure. 465 * e.g. MYCXT.some_data */ 466#define MY_CXT (*my_cxtp) 467 468/* Judicious use of these macros can reduce the number of times dMY_CXT 469 * is used. Use is similar to pTHX, aTHX etc. */ 470#define pMY_CXT my_cxt_t *my_cxtp 471#define pMY_CXT_ pMY_CXT, 472#define _pMY_CXT ,pMY_CXT 473#define aMY_CXT my_cxtp 474#define aMY_CXT_ aMY_CXT, 475#define _aMY_CXT ,aMY_CXT 476 477#else /* single interpreter */ 478 479#define START_MY_CXT static my_cxt_t my_cxt; 480#define dMY_CXT_SV dNOOP 481#define dMY_CXT dNOOP 482#define MY_CXT_INIT NOOP 483#define MY_CXT my_cxt 484 485#define pMY_CXT void 486#define pMY_CXT_ 487#define _pMY_CXT 488#define aMY_CXT 489#define aMY_CXT_ 490#define _aMY_CXT 491 492#endif 493 494#endif /* START_MY_CXT */ 495 496#ifndef IVdf 497# if IVSIZE == LONGSIZE 498# define IVdf "ld" 499# define UVuf "lu" 500# define UVof "lo" 501# define UVxf "lx" 502# define UVXf "lX" 503# else 504# if IVSIZE == INTSIZE 505# define IVdf "d" 506# define UVuf "u" 507# define UVof "o" 508# define UVxf "x" 509# define UVXf "X" 510# endif 511# endif 512#endif 513 514#ifndef NVef 515# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ 516 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ 517# define NVef PERL_PRIeldbl 518# define NVff PERL_PRIfldbl 519# define NVgf PERL_PRIgldbl 520# else 521# define NVef "e" 522# define NVff "f" 523# define NVgf "g" 524# endif 525#endif 526 527#ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */ 528# define AvFILLp AvFILL 529#endif 530 531#ifdef SvPVbyte 532# if PERL_REVISION == 5 && PERL_VERSION < 7 533 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ 534# undef SvPVbyte 535# define SvPVbyte(sv, lp) \ 536 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ 537 ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) 538 static char * 539 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) 540 { 541 sv_utf8_downgrade(sv,0); 542 return SvPV(sv,*lp); 543 } 544# endif 545#else 546# define SvPVbyte SvPV 547#endif 548 549#ifndef SvPV_nolen 550# define SvPV_nolen(sv) \ 551 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ 552 ? SvPVX(sv) : sv_2pv_nolen(sv)) 553 static char * 554 sv_2pv_nolen(pTHX_ register SV *sv) 555 { 556 STRLEN n_a; 557 return sv_2pv(sv, &n_a); 558 } 559#endif 560 561#ifndef get_cv 562# define get_cv(name,create) perl_get_cv(name,create) 563#endif 564 565#ifndef get_sv 566# define get_sv(name,create) perl_get_sv(name,create) 567#endif 568 569#ifndef get_av 570# define get_av(name,create) perl_get_av(name,create) 571#endif 572 573#ifndef get_hv 574# define get_hv(name,create) perl_get_hv(name,create) 575#endif 576 577#endif /* _P_P_PORTABILITY_H_ */ 578 579/* End of File ppport.h */ 580