1 2/* ppport.h -- Perl/Pollution/Portability Version 2.0002 3 * 4 * Automatically Created by Devel::PPPort on Fri May 9 23:08:48 2003 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# ifndef PERL_REVISION 176# define PERL_REVISION (5) 177 /* Replace: 1 */ 178# define PERL_VERSION PATCHLEVEL 179# define PERL_SUBVERSION SUBVERSION 180 /* Replace PERL_PATCHLEVEL with PERL_VERSION */ 181 /* Replace: 0 */ 182# endif 183#endif 184 185#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) 186 187/* It is very unlikely that anyone will try to use this with Perl 6 188 (or greater), but who knows. 189 */ 190#if PERL_REVISION != 5 191# error ppport.h only works with Perl version 5 192#endif /* PERL_REVISION != 5 */ 193 194#ifndef ERRSV 195# define ERRSV perl_get_sv("@",FALSE) 196#endif 197 198#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) 199/* Replace: 1 */ 200# define PL_Sv Sv 201# define PL_compiling compiling 202# define PL_copline copline 203# define PL_curcop curcop 204# define PL_curstash curstash 205# define PL_defgv defgv 206# define PL_dirty dirty 207# define PL_dowarn dowarn 208# define PL_hints hints 209# define PL_na na 210# define PL_perldb perldb 211# define PL_rsfp_filters rsfp_filters 212# define PL_rsfpv rsfp 213# define PL_stdingv stdingv 214# define PL_sv_no sv_no 215# define PL_sv_undef sv_undef 216# define PL_sv_yes sv_yes 217/* Replace: 0 */ 218#endif 219 220#ifdef HASATTRIBUTE 221# if defined(__GNUC__) && defined(__cplusplus) 222# define PERL_UNUSED_DECL 223# else 224# define PERL_UNUSED_DECL __attribute__((unused)) 225# endif 226#else 227# define PERL_UNUSED_DECL 228#endif 229 230#ifndef dNOOP 231# define NOOP (void)0 232# define dNOOP extern int Perl___notused PERL_UNUSED_DECL 233#endif 234 235#ifndef dTHR 236# define dTHR dNOOP 237#endif 238 239#ifndef dTHX 240# define dTHX dNOOP 241# define dTHXa(x) dNOOP 242# define dTHXoa(x) dNOOP 243#endif 244 245#ifndef pTHX 246# define pTHX void 247# define pTHX_ 248# define aTHX 249# define aTHX_ 250#endif 251 252#ifndef UVSIZE 253# define UVSIZE IVSIZE 254#endif 255 256#ifndef NVTYPE 257# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) 258# define NVTYPE long double 259# else 260# define NVTYPE double 261# endif 262typedef NVTYPE NV; 263#endif 264 265#ifndef INT2PTR 266 267#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) 268# define PTRV UV 269# define INT2PTR(any,d) (any)(d) 270#else 271# if PTRSIZE == LONGSIZE 272# define PTRV unsigned long 273# else 274# define PTRV unsigned 275# endif 276# define INT2PTR(any,d) (any)(PTRV)(d) 277#endif 278#define NUM2PTR(any,d) (any)(PTRV)(d) 279#define PTR2IV(p) INT2PTR(IV,p) 280#define PTR2UV(p) INT2PTR(UV,p) 281#define PTR2NV(p) NUM2PTR(NV,p) 282#if PTRSIZE == LONGSIZE 283# define PTR2ul(p) (unsigned long)(p) 284#else 285# define PTR2ul(p) INT2PTR(unsigned long,p) 286#endif 287 288#endif /* !INT2PTR */ 289 290#ifndef boolSV 291# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) 292#endif 293 294#ifndef gv_stashpvn 295# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) 296#endif 297 298#ifndef newSVpvn 299# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) 300#endif 301 302#ifndef newRV_inc 303/* Replace: 1 */ 304# define newRV_inc(sv) newRV(sv) 305/* Replace: 0 */ 306#endif 307 308/* DEFSV appears first in 5.004_56 */ 309#ifndef DEFSV 310# define DEFSV GvSV(PL_defgv) 311#endif 312 313#ifndef SAVE_DEFSV 314# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) 315#endif 316 317#ifndef newRV_noinc 318# ifdef __GNUC__ 319# define newRV_noinc(sv) \ 320 ({ \ 321 SV *nsv = (SV*)newRV(sv); \ 322 SvREFCNT_dec(sv); \ 323 nsv; \ 324 }) 325# else 326# if defined(USE_THREADS) 327static SV * newRV_noinc (SV * sv) 328{ 329 SV *nsv = (SV*)newRV(sv); 330 SvREFCNT_dec(sv); 331 return nsv; 332} 333# else 334# define newRV_noinc(sv) \ 335 (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) 336# endif 337# endif 338#endif 339 340/* Provide: newCONSTSUB */ 341 342/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ 343#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) 344 345#if defined(NEED_newCONSTSUB) 346static 347#else 348extern void newCONSTSUB(HV * stash, char * name, SV *sv); 349#endif 350 351#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) 352void 353newCONSTSUB(stash,name,sv) 354HV *stash; 355char *name; 356SV *sv; 357{ 358 U32 oldhints = PL_hints; 359 HV *old_cop_stash = PL_curcop->cop_stash; 360 HV *old_curstash = PL_curstash; 361 line_t oldline = PL_curcop->cop_line; 362 PL_curcop->cop_line = PL_copline; 363 364 PL_hints &= ~HINT_BLOCK_SCOPE; 365 if (stash) 366 PL_curstash = PL_curcop->cop_stash = stash; 367 368 newSUB( 369 370#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) 371 /* before 5.003_22 */ 372 start_subparse(), 373#else 374# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) 375 /* 5.003_22 */ 376 start_subparse(0), 377# else 378 /* 5.003_23 onwards */ 379 start_subparse(FALSE, 0), 380# endif 381#endif 382 383 newSVOP(OP_CONST, 0, newSVpv(name,0)), 384 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ 385 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) 386 ); 387 388 PL_hints = oldhints; 389 PL_curcop->cop_stash = old_cop_stash; 390 PL_curstash = old_curstash; 391 PL_curcop->cop_line = oldline; 392} 393#endif 394 395#endif /* newCONSTSUB */ 396 397#ifndef START_MY_CXT 398 399/* 400 * Boilerplate macros for initializing and accessing interpreter-local 401 * data from C. All statics in extensions should be reworked to use 402 * this, if you want to make the extension thread-safe. See ext/re/re.xs 403 * for an example of the use of these macros. 404 * 405 * Code that uses these macros is responsible for the following: 406 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" 407 * 2. Declare a typedef named my_cxt_t that is a structure that contains 408 * all the data that needs to be interpreter-local. 409 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. 410 * 4. Use the MY_CXT_INIT macro such that it is called exactly once 411 * (typically put in the BOOT: section). 412 * 5. Use the members of the my_cxt_t structure everywhere as 413 * MY_CXT.member. 414 * 6. Use the dMY_CXT macro (a declaration) in all the functions that 415 * access MY_CXT. 416 */ 417 418#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ 419 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) 420 421/* This must appear in all extensions that define a my_cxt_t structure, 422 * right after the definition (i.e. at file scope). The non-threads 423 * case below uses it to declare the data as static. */ 424#define START_MY_CXT 425 426#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) 427/* Fetches the SV that keeps the per-interpreter data. */ 428#define dMY_CXT_SV \ 429 SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) 430#else /* >= perl5.004_68 */ 431#define dMY_CXT_SV \ 432 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ 433 sizeof(MY_CXT_KEY)-1, TRUE) 434#endif /* < perl5.004_68 */ 435 436/* This declaration should be used within all functions that use the 437 * interpreter-local data. */ 438#define dMY_CXT \ 439 dMY_CXT_SV; \ 440 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) 441 442/* Creates and zeroes the per-interpreter data. 443 * (We allocate my_cxtp in a Perl SV so that it will be released when 444 * the interpreter goes away.) */ 445#define MY_CXT_INIT \ 446 dMY_CXT_SV; \ 447 /* newSV() allocates one more than needed */ \ 448 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ 449 Zero(my_cxtp, 1, my_cxt_t); \ 450 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) 451 452/* This macro must be used to access members of the my_cxt_t structure. 453 * e.g. MYCXT.some_data */ 454#define MY_CXT (*my_cxtp) 455 456/* Judicious use of these macros can reduce the number of times dMY_CXT 457 * is used. Use is similar to pTHX, aTHX etc. */ 458#define pMY_CXT my_cxt_t *my_cxtp 459#define pMY_CXT_ pMY_CXT, 460#define _pMY_CXT ,pMY_CXT 461#define aMY_CXT my_cxtp 462#define aMY_CXT_ aMY_CXT, 463#define _aMY_CXT ,aMY_CXT 464 465#else /* single interpreter */ 466 467 468#define START_MY_CXT static my_cxt_t my_cxt; 469#define dMY_CXT_SV dNOOP 470#define dMY_CXT dNOOP 471#define MY_CXT_INIT NOOP 472#define MY_CXT my_cxt 473 474#define pMY_CXT void 475#define pMY_CXT_ 476#define _pMY_CXT 477#define aMY_CXT 478#define aMY_CXT_ 479#define _aMY_CXT 480 481#endif 482 483#endif /* START_MY_CXT */ 484 485#ifndef IVdf 486# if IVSIZE == LONGSIZE 487# define IVdf "ld" 488# define UVuf "lu" 489# define UVof "lo" 490# define UVxf "lx" 491# define UVXf "lX" 492# else 493# if IVSIZE == INTSIZE 494# define IVdf "d" 495# define UVuf "u" 496# define UVof "o" 497# define UVxf "x" 498# define UVXf "X" 499# endif 500# endif 501#endif 502 503#ifndef NVef 504# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ 505 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ 506# define NVef PERL_PRIeldbl 507# define NVff PERL_PRIfldbl 508# define NVgf PERL_PRIgldbl 509# else 510# define NVef "e" 511# define NVff "f" 512# define NVgf "g" 513# endif 514#endif 515 516#ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */ 517# define AvFILLp AvFILL 518#endif 519 520#ifdef SvPVbyte 521# if PERL_REVISION == 5 && PERL_VERSION < 7 522 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ 523# undef SvPVbyte 524# define SvPVbyte(sv, lp) \ 525 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ 526 ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) 527 static char * 528 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) 529 { 530 sv_utf8_downgrade(sv,0); 531 return SvPV(sv,*lp); 532 } 533# endif 534#else 535# define SvPVbyte SvPV 536#endif 537 538#endif /* _P_P_PORTABILITY_H_ */ 539 540/* End of File ppport.h */ 541