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 /* IV could also be a quad (say, a long long), but Perls
 438  * capable of those should have IVSIZE already. */
 439 #if !defined(IVSIZE) && defined(LONGSIZE)
 440 #   define IVSIZE LONGSIZE
 441 #endif
 442 #ifndef IVSIZE
 443 #   define IVSIZE 4 /* A bold guess, but the best we can make. */
 444 #endif
 445
 446 #ifndef UVSIZE
 447 #   define UVSIZE IVSIZE
 448 #endif
 449
 450 #ifndef NVTYPE
 451 #   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
 452 #       define NVTYPE long double
 453 #   else
 454 #       define NVTYPE double
 455 #   endif
 456 typedef NVTYPE NV;
 457 #endif
 458
 459 #ifndef INT2PTR
 460
 461 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
 462 #  define PTRV                  UV
 463 #  define INT2PTR(any,d)        (any)(d)
 464 #else
 465 #  if PTRSIZE == LONGSIZE
 466 #    define PTRV                unsigned long
 467 #  else
 468 #    define PTRV                unsigned
 469 #  endif
 470 #  define INT2PTR(any,d)        (any)(PTRV)(d)
 471 #endif
 472 #define NUM2PTR(any,d)  (any)(PTRV)(d)
 473 #define PTR2IV(p)       INT2PTR(IV,p)
 474 #define PTR2UV(p)       INT2PTR(UV,p)
 475 #define PTR2NV(p)       NUM2PTR(NV,p)
 476 #if PTRSIZE == LONGSIZE
 477 #  define PTR2ul(p)     (unsigned long)(p)
 478 #else
 479 #  define PTR2ul(p)     INT2PTR(unsigned long,p)
 480 #endif
 481
 482 #endif /* !INT2PTR */
 483
 484 #ifndef boolSV
 485 #       define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
 486 #endif
 487
 488 #ifndef gv_stashpvn
 489 #       define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
 490 #endif
 491
 492 #ifndef newSVpvn
 493 #       define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
 494 #endif
 495
 496 #ifndef newRV_inc
 497 /* Replace: 1 */
 498 #       define newRV_inc(sv) newRV(sv)
 499 /* Replace: 0 */
 500 #endif
 501
 502 /* DEFSV appears first in 5.004_56 */
 503 #ifndef DEFSV
 504 #  define DEFSV GvSV(PL_defgv)
 505 #endif
 506
 507 #ifndef SAVE_DEFSV
 508 #    define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
 509 #endif
 510
 511 #ifndef newRV_noinc
 512 #  ifdef __GNUC__
 513 #    define newRV_noinc(sv)               \
 514       ({                                  \
 515           SV *nsv = (SV*)newRV(sv);       \
 516           SvREFCNT_dec(sv);               \
 517           nsv;                            \
 518       })
 519 #  else
 520 #    if defined(USE_THREADS)
 521 static SV * newRV_noinc (SV * sv)
 522 {
 523           SV *nsv = (SV*)newRV(sv);
 524           SvREFCNT_dec(sv);
 525           return nsv;
 526 }
 527 #    else
 528 #      define newRV_noinc(sv)    \
 529         (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
 530 #    endif
 531 #  endif
 532 #endif
 533
 534 /* Provide: newCONSTSUB */
 535
 536 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
 537 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
 538
 539 #if defined(NEED_newCONSTSUB)
 540 static
 541 #else
 542 extern void newCONSTSUB(HV * stash, char * name, SV *sv);
 543 #endif
 544
 545 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
 546 void
 547 newCONSTSUB(stash,name,sv)
 548 HV *stash;
 549 char *name;
 550 SV *sv;
 551 {
 552         U32 oldhints = PL_hints;
 553         HV *old_cop_stash = PL_curcop->cop_stash;
 554         HV *old_curstash = PL_curstash;
 555         line_t oldline = PL_curcop->cop_line;
 556         PL_curcop->cop_line = PL_copline;
 557
 558         PL_hints &= ~HINT_BLOCK_SCOPE;
 559         if (stash)
 560                 PL_curstash = PL_curcop->cop_stash = stash;
 561
 562         newSUB(
 563
 564 #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
 565      /* before 5.003_22 */
 566                 start_subparse(),
 567 #else
 568 #  if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
 569      /* 5.003_22 */
 570                 start_subparse(0),
 571 #  else
 572      /* 5.003_23  onwards */
 573                 start_subparse(FALSE, 0),
 574 #  endif
 575 #endif
 576
 577                 newSVOP(OP_CONST, 0, newSVpv(name,0)),
 578                 newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
 579                 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
 580         );
 581
 582         PL_hints = oldhints;
 583         PL_curcop->cop_stash = old_cop_stash;
 584         PL_curstash = old_curstash;
 585         PL_curcop->cop_line = oldline;
 586 }
 587 #endif
 588
 589 #endif /* newCONSTSUB */
 590
 591 #ifndef START_MY_CXT
 592
 593 /*
 594  * Boilerplate macros for initializing and accessing interpreter-local
 595  * data from C.  All statics in extensions should be reworked to use
 596  * this, if you want to make the extension thread-safe.  See ext/re/re.xs
 597  * for an example of the use of these macros.
 598  *
 599  * Code that uses these macros is responsible for the following:
 600  * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
 601  * 2. Declare a typedef named my_cxt_t that is a structure that contains
 602  *    all the data that needs to be interpreter-local.
 603  * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
 604  * 4. Use the MY_CXT_INIT macro such that it is called exactly once
 605  *    (typically put in the BOOT: section).
 606  * 5. Use the members of the my_cxt_t structure everywhere as
 607  *    MY_CXT.member.
 608  * 6. Use the dMY_CXT macro (a declaration) in all the functions that
 609  *    access MY_CXT.
 610  */
 611
 612 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
 613     defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
 614
 615 /* This must appear in all extensions that define a my_cxt_t structure,
 616  * right after the definition (i.e. at file scope).  The non-threads
 617  * case below uses it to declare the data as static. */
 618 #define START_MY_CXT
 619
 620 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
 621 /* Fetches the SV that keeps the per-interpreter data. */
 622 #define dMY_CXT_SV \
 623         SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
 624 #else /* >= perl5.004_68 */
 625 #define dMY_CXT_SV \
 626         SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,             \
 627                                   sizeof(MY_CXT_KEY)-1, TRUE)
 628 #endif /* < perl5.004_68 */
 629
 630 /* This declaration should be used within all functions that use the
 631  * interpreter-local data. */
 632 #define dMY_CXT \
 633         dMY_CXT_SV;                                                     \
 634         my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
 635
 636 /* Creates and zeroes the per-interpreter data.
 637  * (We allocate my_cxtp in a Perl SV so that it will be released when
 638  * the interpreter goes away.) */
 639 #define MY_CXT_INIT \
 640         dMY_CXT_SV;                                                     \
 641         /* newSV() allocates one more than needed */                    \
 642         my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
 643         Zero(my_cxtp, 1, my_cxt_t);                                     \
 644         sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
 645
 646 /* This macro must be used to access members of the my_cxt_t structure.
 647  * e.g. MYCXT.some_data */
 648 #define MY_CXT          (*my_cxtp)
 649
 650 /* Judicious use of these macros can reduce the number of times dMY_CXT
 651  * is used.  Use is similar to pTHX, aTHX etc. */
 652 #define pMY_CXT         my_cxt_t *my_cxtp
 653 #define pMY_CXT_        pMY_CXT,
 654 #define _pMY_CXT        ,pMY_CXT
 655 #define aMY_CXT         my_cxtp
 656 #define aMY_CXT_        aMY_CXT,
 657 #define _aMY_CXT        ,aMY_CXT
 658
 659 #else /* single interpreter */
 660
 661 #define START_MY_CXT    static my_cxt_t my_cxt;
 662 #define dMY_CXT_SV      dNOOP
 663 #define dMY_CXT         dNOOP
 664 #define MY_CXT_INIT     NOOP
 665 #define MY_CXT          my_cxt
 666
 667 #define pMY_CXT         void
 668 #define pMY_CXT_
 669 #define _pMY_CXT
 670 #define aMY_CXT
 671 #define aMY_CXT_
 672 #define _aMY_CXT
 673
 674 #endif
 675
 676 #endif /* START_MY_CXT */
 677
 678 #ifndef IVdf
 679 #  if IVSIZE == LONGSIZE
 680 #       define  IVdf            "ld"
 681 #       define  UVuf            "lu"
 682 #       define  UVof            "lo"
 683 #       define  UVxf            "lx"
 684 #       define  UVXf            "lX"
 685 #   else
 686 #       if IVSIZE == INTSIZE
 687 #           define      IVdf    "d"
 688 #           define      UVuf    "u"
 689 #           define      UVof    "o"
 690 #           define      UVxf    "x"
 691 #           define      UVXf    "X"
 692 #       endif
 693 #   endif
 694 #endif
 695
 696 #ifndef NVef
 697 #   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
 698         defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
 699 #       define NVef             PERL_PRIeldbl
 700 #       define NVff             PERL_PRIfldbl
 701 #       define NVgf             PERL_PRIgldbl
 702 #   else
 703 #       define NVef             "e"
 704 #       define NVff             "f"
 705 #       define NVgf             "g"
 706 #   endif
 707 #endif
 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 #ifndef SvPV_nolen
 732 #   define SvPV_nolen(sv) \
 733         ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
 734          ? SvPVX(sv) : sv_2pv_nolen(sv))
 735     static char *
 736     sv_2pv_nolen(pTHX_ register SV *sv)
 737     {
 738         STRLEN n_a;
 739         return sv_2pv(sv, &n_a);
 740     }
 741 #endif
 742
 743 #endif /* _P_P_PORTABILITY_H_ */
 744
 745 /* End of File ppport.h */