ext/Devel/PPPort/PPPort.pm

   1
   2 package Devel::PPPort;
   3
   4 =head1 NAME
   5
   6 Perl/Pollution/Portability
   7
   8 =head1 SYNOPSIS
   9
  10     Devel::PPPort::WriteFile() ; # defaults to ./ppport.h
  11     Devel::PPPort::WriteFile('someheader.h') ;
  12
  13 =head1 DESCRIPTION
  14
  15 Perl has changed over time, gaining new features, new functions,
  16 increasing its flexibility, and reducing the impact on the C namespace
  17 environment (reduced pollution). The header file, typicaly C<ppport.h>,
  18 written by this module attempts to bring some of the newer Perl
  19 features to older versions of Perl, so that you can worry less about
  20 keeping track of old releases, but users can still reap the benefit.
  21
  22 Why you should use C<ppport.h> in modern code: so that your code will work
  23 with the widest range of Perl interpreters possible, without significant
  24 additional work.
  25
  26 Why you should attempt older code to fully use C<ppport.h>: because
  27 the reduced pollution of newer Perl versions is an important thing, so
  28 important that the old polluting ways of original Perl modules will not be
  29 supported very far into the future, and your module will almost certainly
  30 break! By adapting to it now, you'll gained compatibility and a sense of
  31 having done the electronic ecology some good.
  32
  33 How to use ppport.h: Don't direct the user to download C<Devel::PPPort>,
  34 and don't make C<ppport.h> optional. Rather, just take the most recent
  35 copy of C<ppport.h> that you can find (probably in C<Devel::PPPort>
  36 on CPAN), copy it into your project, adjust your project to use it,
  37 and distribute the header along with your module.
  38
  39 C<Devel::PPPort> contains a single function, called C<WriteFile>. It's
  40 purpose is to write a 'C' header file that is used when writing XS
  41 modules. The file contains a series of macros that allow XS modules to
  42 be built using older versions of Perl.
  43
  44 This module is used by h2xs to write the file F<ppport.h>.
  45
  46 =head2 WriteFile
  47
  48 C<WriteFile> takes a zero or one parameters. When called with one
  49 parameter it expects to be passed a filename. When called with no
  50 parameters, it defults to the filename C<./pport.h>.
  51
  52 The function returns TRUE if the file was written successfully. Otherwise
  53 it returns FALSE.
  54
  55 =head1 ppport.h
  56
  57 The file written by this module, typically C<ppport.h>, provides access
  58 to the following Perl API if not already available (and in some cases [*]
  59 even if available, access to a fixed interface):
  60
  61     aMY_CXT
  62     aMY_CXT_
  63     _aMY_CXT
  64     aTHX
  65     aTHX_
  66     AvFILLp
  67     boolSV(b)
  68     DEFSV
  69     dMY_CXT
  70     dMY_CXT_SV
  71     dNOOP
  72     dTHR
  73     dTHX
  74     dTHXa
  75     dTHXoa
  76     ERRSV
  77     gv_stashpvn(str,len,flags)
  78     INT2PTR(type,int)
  79     IVdf
  80     MY_CXT
  81     MY_CXT_INIT
  82     newCONSTSUB(stash,name,sv)
  83     newRV_inc(sv)
  84     newRV_noinc(sv)
  85     newSVpvn(data,len)
  86     NOOP
  87     NV
  88     NVef
  89     NVff
  90     NVgf
  91     PERL_REVISION
  92     PERL_SUBVERSION
  93     PERL_UNUSED_DECL
  94     PERL_UNUSED_DECL
  95     PERL_VERSION
  96     PL_compiling
  97     PL_copline
  98     PL_curcop
  99     PL_curstash
 100     PL_defgv
 101     PL_dirty
 102     PL_hints
 103     PL_na
 104     PL_perldb
 105     PL_rsfp_filters
 106     PL_rsfpv
 107     PL_stdingv
 108     PL_Sv
 109     PL_sv_no
 110     PL_sv_undef
 111     PL_sv_yes
 112     pMY_CXT
 113     pMY_CXT_
 114     _pMY_CXT
 115     pTHX
 116     pTHX_
 117     PTR2IV(ptr)
 118     PTR2NV(ptr)
 119     PTR2ul(ptr)
 120     PTR2UV(ptr)
 121     SAVE_DEFSV
 122     START_MY_CXT
 123     SvPVbyte(sv,lp) [*]
 124     UVof
 125     UVSIZE
 126     UVuf
 127     UVxf
 128     UVXf
 129
 130 =head1 AUTHOR
 131
 132 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
 133
 134 Version 2.x was ported to the Perl core by Paul Marquess.
 135
 136 =head1 SEE ALSO
 137
 138 See L<h2xs>.
 139
 140 =cut
 141
 142
 143 package Devel::PPPort;
 144
 145 require Exporter;
 146 require DynaLoader;
 147 #use warnings;
 148 use strict;
 149 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data );
 150
 151 $VERSION = "2.0002";
 152
 153 @ISA = qw(Exporter DynaLoader);
 154 @EXPORT =  qw();
 155 # Other items we are prepared to export if requested
 156 @EXPORT_OK = qw( );
 157
 158 bootstrap Devel::PPPort;
 159
 160 package Devel::PPPort;
 161
 162 {
 163     local $/ = undef;
 164     $data = <DATA> ;
 165     my $now = localtime;
 166     my $pkg = __PACKAGE__;
 167     $data =~ s/__VERSION__/$VERSION/g;
 168     $data =~ s/__DATE__/$now/g;
 169     $data =~ s/__PKG__/$pkg/g;
 170 }
 171
 172 sub WriteFile
 173 {
 174     my $file = shift || 'ppport.h' ;
 175
 176     open F, ">$file" || return undef ;
 177     print F $data ;
 178     close F;
 179
 180     return 1 ;
 181 }
 182
 183 1;
 184
 185 __DATA__;
 186
 187 /* ppport.h -- Perl/Pollution/Portability Version __VERSION__
 188  *
 189  * Automatically Created by __PKG__ on __DATE__
 190  *
 191  * Do NOT edit this file directly! -- Edit PPPort.pm instead.
 192  *
 193  * Version 2.x, Copyright (C) 2001, Paul Marquess.
 194  * Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
 195  * This code may be used and distributed under the same license as any
 196  * version of Perl.
 197  *
 198  * This version of ppport.h is designed to support operation with Perl
 199  * installations back to 5.004, and has been tested up to 5.8.0.
 200  *
 201  * If this version of ppport.h is failing during the compilation of this
 202  * module, please check if a newer version of Devel::PPPort is available
 203  * on CPAN before sending a bug report.
 204  *
 205  * If you are using the latest version of Devel::PPPort and it is failing
 206  * during compilation of this module, please send a report to perlbug@perl.com
 207  *
 208  * Include all following information:
 209  *
 210  *  1. The complete output from running "perl -V"
 211  *
 212  *  2. This file.
 213  *
 214  *  3. The name & version of the module you were trying to build.
 215  *
 216  *  4. A full log of the build that failed.
 217  *
 218  *  5. Any other information that you think could be relevant.
 219  *
 220  *
 221  * For the latest version of this code, please retreive the Devel::PPPort
 222  * module from CPAN.
 223  *
 224  */
 225
 226 /*
 227  * In order for a Perl extension module to be as portable as possible
 228  * across differing versions of Perl itself, certain steps need to be taken.
 229  * Including this header is the first major one, then using dTHR is all the
 230  * appropriate places and using a PL_ prefix to refer to global Perl
 231  * variables is the second.
 232  *
 233  */
 234
 235
 236 /* If you use one of a few functions that were not present in earlier
 237  * versions of Perl, please add a define before the inclusion of ppport.h
 238  * for a static include, or use the GLOBAL request in a single module to
 239  * produce a global definition that can be referenced from the other
 240  * modules.
 241  *
 242  * Function:            Static define:           Extern define:
 243  * newCONSTSUB()        NEED_newCONSTSUB         NEED_newCONSTSUB_GLOBAL
 244  *
 245  */
 246
 247
 248 /* To verify whether ppport.h is needed for your module, and whether any
 249  * special defines should be used, ppport.h can be run through Perl to check
 250  * your source code. Simply say:
 251  *
 252  *      perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
 253  *
 254  * The result will be a list of patches suggesting changes that should at
 255  * least be acceptable, if not necessarily the most efficient solution, or a
 256  * fix for all possible problems. It won't catch where dTHR is needed, and
 257  * doesn't attempt to account for global macro or function definitions,
 258  * nested includes, typemaps, etc.
 259  *
 260  * In order to test for the need of dTHR, please try your module under a
 261  * recent version of Perl that has threading compiled-in.
 262  *
 263  */
 264
 265
 266 /*
 267 #!/usr/bin/perl
 268 @ARGV = ("*.xs") if !@ARGV;
 269 %badmacros = %funcs = %macros = (); $replace = 0;
 270 foreach (<DATA>) {
 271         $funcs{$1} = 1 if /Provide:\s+(\S+)/;
 272         $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
 273         $replace = $1 if /Replace:\s+(\d+)/;
 274         $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
 275         $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
 276 }
 277 foreach $filename (map(glob($_),@ARGV)) {
 278         unless (open(IN, "<$filename")) {
 279                 warn "Unable to read from $file: $!\n";
 280                 next;
 281         }
 282         print "Scanning $filename...\n";
 283         $c = ""; while (<IN>) { $c .= $_; } close(IN);
 284         $need_include = 0; %add_func = (); $changes = 0;
 285         $has_include = ($c =~ /#.*include.*ppport/m);
 286
 287         foreach $func (keys %funcs) {
 288                 if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
 289                         if ($c !~ /\b$func\b/m) {
 290                                 print "If $func isn't needed, you don't need to request it.\n" if
 291                                 $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
 292                         } else {
 293                                 print "Uses $func\n";
 294                                 $need_include = 1;
 295                         }
 296                 } else {
 297                         if ($c =~ /\b$func\b/m) {
 298                                 $add_func{$func} =1 ;
 299                                 print "Uses $func\n";
 300                                 $need_include = 1;
 301                         }
 302                 }
 303         }
 304
 305         if (not $need_include) {
 306                 foreach $macro (keys %macros) {
 307                         if ($c =~ /\b$macro\b/m) {
 308                                 print "Uses $macro\n";
 309                                 $need_include = 1;
 310                         }
 311                 }
 312         }
 313
 314         foreach $badmacro (keys %badmacros) {
 315                 if ($c =~ /\b$badmacro\b/m) {
 316                         $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
 317                         print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
 318                         $need_include = 1;
 319                 }
 320         }
 321
 322         if (scalar(keys %add_func) or $need_include != $has_include) {
 323                 if (!$has_include) {
 324                         $inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
 325                                "#include \"ppport.h\"\n";
 326                         $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
 327                 } elsif (keys %add_func) {
 328                         $inc = join('',map("#define NEED_$_\n", sort keys %add_func));
 329                         $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
 330                 }
 331                 if (!$need_include) {
 332                         print "Doesn't seem to need ppport.h.\n";
 333                         $c =~ s/^.*#.*include.*ppport.*\n//m;
 334                 }
 335                 $changes++;
 336         }
 337
 338         if ($changes) {
 339                 open(OUT,">/tmp/ppport.h.$$");
 340                 print OUT $c;
 341                 close(OUT);
 342                 open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
 343                 while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
 344                 close(DIFF);
 345                 unlink("/tmp/ppport.h.$$");
 346         } else {
 347                 print "Looks OK\n";
 348         }
 349 }
 350 __DATA__
 351 */
 352
 353 #ifndef _P_P_PORTABILITY_H_
 354 #define _P_P_PORTABILITY_H_
 355
 356 #ifndef PERL_REVISION
 357 #   ifndef __PATCHLEVEL_H_INCLUDED__
 358 #       include "patchlevel.h"
 359 #   endif
 360 #   ifndef PERL_REVISION
 361 #       define PERL_REVISION    (5)
 362         /* Replace: 1 */
 363 #       define PERL_VERSION     PATCHLEVEL
 364 #       define PERL_SUBVERSION  SUBVERSION
 365         /* Replace PERL_PATCHLEVEL with PERL_VERSION */
 366         /* Replace: 0 */
 367 #   endif
 368 #endif
 369
 370 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
 371
 372 /* It is very unlikely that anyone will try to use this with Perl 6
 373    (or greater), but who knows.
 374  */
 375 #if PERL_REVISION != 5
 376 #       error ppport.h only works with Perl version 5
 377 #endif /* PERL_REVISION != 5 */
 378
 379 #ifndef ERRSV
 380 #       define ERRSV perl_get_sv("@",FALSE)
 381 #endif
 382
 383 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
 384 /* Replace: 1 */
 385 #       define PL_Sv            Sv
 386 #       define PL_compiling     compiling
 387 #       define PL_copline       copline
 388 #       define PL_curcop        curcop
 389 #       define PL_curstash      curstash
 390 #       define PL_defgv         defgv
 391 #       define PL_dirty         dirty
 392 #       define PL_dowarn        dowarn
 393 #       define PL_hints         hints
 394 #       define PL_na            na
 395 #       define PL_perldb        perldb
 396 #       define PL_rsfp_filters  rsfp_filters
 397 #       define PL_rsfpv         rsfp
 398 #       define PL_stdingv       stdingv
 399 #       define PL_sv_no         sv_no
 400 #       define PL_sv_undef      sv_undef
 401 #       define PL_sv_yes        sv_yes
 402 /* Replace: 0 */
 403 #endif
 404
 405 #ifdef HASATTRIBUTE
 406 #  if defined(__GNUC__) && defined(__cplusplus)
 407 #    define PERL_UNUSED_DECL
 408 #  else
 409 #    define PERL_UNUSED_DECL __attribute__((unused))
 410 #  endif
 411 #else
 412 #  define PERL_UNUSED_DECL
 413 #endif
 414
 415 #ifndef dNOOP
 416 #  define NOOP (void)0
 417 #  define dNOOP extern int Perl___notused PERL_UNUSED_DECL
 418 #endif
 419
 420 #ifndef dTHR
 421 #  define dTHR          dNOOP
 422 #endif
 423
 424 #ifndef dTHX
 425 #  define dTHX          dNOOP
 426 #  define dTHXa(x)      dNOOP
 427 #  define dTHXoa(x)     dNOOP
 428 #endif
 429
 430 #ifndef pTHX
 431 #    define pTHX        void
 432 #    define pTHX_
 433 #    define aTHX
 434 #    define aTHX_
 435 #endif
 436
 437 #ifndef PTR2IV
 438 #    define PTR2IV(d)   (IV)(d)
 439 #endif
 440
 441 #ifndef INT2PTR
 442 #    define INT2PTR(any,d)      (any)(d)
 443 #endif
 444
 445 #ifndef boolSV
 446 #       define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
 447 #endif
 448
 449 #ifndef gv_stashpvn
 450 #       define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
 451 #endif
 452
 453 #ifndef newSVpvn
 454 #       define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
 455 #endif
 456
 457 #ifndef newRV_inc
 458 /* Replace: 1 */
 459 #       define newRV_inc(sv) newRV(sv)
 460 /* Replace: 0 */
 461 #endif
 462
 463 /* DEFSV appears first in 5.004_56 */
 464 #ifndef DEFSV
 465 #  define DEFSV GvSV(PL_defgv)
 466 #endif
 467
 468 #ifndef SAVE_DEFSV
 469 #    define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
 470 #endif
 471
 472 #ifndef newRV_noinc
 473 #  ifdef __GNUC__
 474 #    define newRV_noinc(sv)               \
 475       ({                                  \
 476           SV *nsv = (SV*)newRV(sv);       \
 477           SvREFCNT_dec(sv);               \
 478           nsv;                            \
 479       })
 480 #  else
 481 #    if defined(USE_THREADS)
 482 static SV * newRV_noinc (SV * sv)
 483 {
 484           SV *nsv = (SV*)newRV(sv);
 485           SvREFCNT_dec(sv);
 486           return nsv;
 487 }
 488 #    else
 489 #      define newRV_noinc(sv)    \
 490         (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
 491 #    endif
 492 #  endif
 493 #endif
 494
 495 /* Provide: newCONSTSUB */
 496
 497 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
 498 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
 499
 500 #if defined(NEED_newCONSTSUB)
 501 static
 502 #else
 503 extern void newCONSTSUB(HV * stash, char * name, SV *sv);
 504 #endif
 505
 506 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
 507 void
 508 newCONSTSUB(stash,name,sv)
 509 HV *stash;
 510 char *name;
 511 SV *sv;
 512 {
 513         U32 oldhints = PL_hints;
 514         HV *old_cop_stash = PL_curcop->cop_stash;
 515         HV *old_curstash = PL_curstash;
 516         line_t oldline = PL_curcop->cop_line;
 517         PL_curcop->cop_line = PL_copline;
 518
 519         PL_hints &= ~HINT_BLOCK_SCOPE;
 520         if (stash)
 521                 PL_curstash = PL_curcop->cop_stash = stash;
 522
 523         newSUB(
 524
 525 #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
 526      /* before 5.003_22 */
 527                 start_subparse(),
 528 #else
 529 #  if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
 530      /* 5.003_22 */
 531                 start_subparse(0),
 532 #  else
 533      /* 5.003_23  onwards */
 534                 start_subparse(FALSE, 0),
 535 #  endif
 536 #endif
 537
 538                 newSVOP(OP_CONST, 0, newSVpv(name,0)),
 539                 newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
 540                 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
 541         );
 542
 543         PL_hints = oldhints;
 544         PL_curcop->cop_stash = old_cop_stash;
 545         PL_curstash = old_curstash;
 546         PL_curcop->cop_line = oldline;
 547 }
 548 #endif
 549
 550 #endif /* newCONSTSUB */
 551
 552 #ifndef START_MY_CXT
 553
 554 /*
 555  * Boilerplate macros for initializing and accessing interpreter-local
 556  * data from C.  All statics in extensions should be reworked to use
 557  * this, if you want to make the extension thread-safe.  See ext/re/re.xs
 558  * for an example of the use of these macros.
 559  *
 560  * Code that uses these macros is responsible for the following:
 561  * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
 562  * 2. Declare a typedef named my_cxt_t that is a structure that contains
 563  *    all the data that needs to be interpreter-local.
 564  * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
 565  * 4. Use the MY_CXT_INIT macro such that it is called exactly once
 566  *    (typically put in the BOOT: section).
 567  * 5. Use the members of the my_cxt_t structure everywhere as
 568  *    MY_CXT.member.
 569  * 6. Use the dMY_CXT macro (a declaration) in all the functions that
 570  *    access MY_CXT.
 571  */
 572
 573 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
 574     defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
 575
 576 /* This must appear in all extensions that define a my_cxt_t structure,
 577  * right after the definition (i.e. at file scope).  The non-threads
 578  * case below uses it to declare the data as static. */
 579 #define START_MY_CXT
 580
 581 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
 582 /* Fetches the SV that keeps the per-interpreter data. */
 583 #define dMY_CXT_SV \
 584         SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
 585 #else /* >= perl5.004_68 */
 586 #define dMY_CXT_SV \
 587         SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,             \
 588                                   sizeof(MY_CXT_KEY)-1, TRUE)
 589 #endif /* < perl5.004_68 */
 590
 591 /* This declaration should be used within all functions that use the
 592  * interpreter-local data. */
 593 #define dMY_CXT \
 594         dMY_CXT_SV;                                                     \
 595         my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
 596
 597 /* Creates and zeroes the per-interpreter data.
 598  * (We allocate my_cxtp in a Perl SV so that it will be released when
 599  * the interpreter goes away.) */
 600 #define MY_CXT_INIT \
 601         dMY_CXT_SV;                                                     \
 602         /* newSV() allocates one more than needed */                    \
 603         my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
 604         Zero(my_cxtp, 1, my_cxt_t);                                     \
 605         sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
 606
 607 /* This macro must be used to access members of the my_cxt_t structure.
 608  * e.g. MYCXT.some_data */
 609 #define MY_CXT          (*my_cxtp)
 610
 611 /* Judicious use of these macros can reduce the number of times dMY_CXT
 612  * is used.  Use is similar to pTHX, aTHX etc. */
 613 #define pMY_CXT         my_cxt_t *my_cxtp
 614 #define pMY_CXT_        pMY_CXT,
 615 #define _pMY_CXT        ,pMY_CXT
 616 #define aMY_CXT         my_cxtp
 617 #define aMY_CXT_        aMY_CXT,
 618 #define _aMY_CXT        ,aMY_CXT
 619
 620 #else /* single interpreter */
 621
 622
 623 #define START_MY_CXT    static my_cxt_t my_cxt;
 624 #define dMY_CXT_SV      dNOOP
 625 #define dMY_CXT         dNOOP
 626 #define MY_CXT_INIT     NOOP
 627 #define MY_CXT          my_cxt
 628
 629 #define pMY_CXT         void
 630 #define pMY_CXT_
 631 #define _pMY_CXT
 632 #define aMY_CXT
 633 #define aMY_CXT_
 634 #define _aMY_CXT
 635
 636 #endif
 637
 638 #endif /* START_MY_CXT */
 639
 640 #ifndef IVdf
 641 #  if IVSIZE == LONGSIZE
 642 #       define  IVdf            "ld"
 643 #       define  UVuf            "lu"
 644 #       define  UVof            "lo"
 645 #       define  UVxf            "lx"
 646 #       define  UVXf            "lX"
 647 #   else
 648 #       if IVSIZE == INTSIZE
 649 #           define      IVdf    "d"
 650 #           define      UVuf    "u"
 651 #           define      UVof    "o"
 652 #           define      UVxf    "x"
 653 #           define      UVXf    "X"
 654 #       endif
 655 #   endif
 656 #endif
 657
 658 #ifndef NVef
 659 #   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
 660         defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
 661 #       define NVef             PERL_PRIeldbl
 662 #       define NVff             PERL_PRIfldbl
 663 #       define NVgf             PERL_PRIgldbl
 664 #   else
 665 #       define NVef             "e"
 666 #       define NVff             "f"
 667 #       define NVgf             "g"
 668 #   endif
 669 #endif
 670
 671 #ifndef UVSIZE
 672 #   define UVSIZE IVSIZE
 673 #endif
 674
 675 #ifndef NVTYPE
 676 #   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
 677 #       define NVTYPE long double
 678 #   else
 679 #       define NVTYPE double
 680 #   endif
 681 typedef NVTYPE NV;
 682 #endif
 683
 684 #ifndef INT2PTR
 685
 686 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
 687 #  define PTRV                  UV
 688 #  define INT2PTR(any,d)        (any)(d)
 689 #else
 690 #  if PTRSIZE == LONGSIZE
 691 #    define PTRV                unsigned long
 692 #  else
 693 #    define PTRV                unsigned
 694 #  endif
 695 #  define INT2PTR(any,d)        (any)(PTRV)(d)
 696 #endif
 697 #define NUM2PTR(any,d)  (any)(PTRV)(d)
 698 #define PTR2IV(p)       INT2PTR(IV,p)
 699 #define PTR2UV(p)       INT2PTR(UV,p)
 700 #define PTR2NV(p)       NUM2PTR(NV,p)
 701 #if PTRSIZE == LONGSIZE
 702 #  define PTR2ul(p)     (unsigned long)(p)
 703 #else
 704 #  define PTR2ul(p)     INT2PTR(unsigned long,p)
 705 #endif
 706
 707 #endif /* !INT2PTR */
 708
 709 #ifndef AvFILLp                 /* Older perls (<=5.003) lack AvFILLp */
 710 #   define AvFILLp AvFILL
 711 #endif
 712
 713 #ifdef SvPVbyte
 714 #   if PERL_REVISION == 5 && PERL_VERSION < 7
 715        /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
 716 #       undef SvPVbyte
 717 #       define SvPVbyte(sv, lp) \
 718           ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
 719            ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
 720        static char *
 721        my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
 722        {
 723            sv_utf8_downgrade(sv,0);
 724            return SvPV(sv,*lp);
 725        }
 726 #   endif
 727 #else
 728 #   define SvPVbyte SvPV
 729 #endif
 730
 731 #endif /* _P_P_PORTABILITY_H_ */
 732
 733 /* End of File ppport.h */