ext/Devel/PPPort/PPPort.pm

   1
   2 package Devel::PPPort;
   3
   4 =head1 NAME
   5
   6 Devel::PPPort - 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 #   if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
 361 #       include <could_not_find_Perl_patchlevel.h>
 362 #   endif
 363 #   ifndef PERL_REVISION
 364 #       define PERL_REVISION    (5)
 365         /* Replace: 1 */
 366 #       define PERL_VERSION     PATCHLEVEL
 367 #       define PERL_SUBVERSION  SUBVERSION
 368         /* Replace PERL_PATCHLEVEL with PERL_VERSION */
 369         /* Replace: 0 */
 370 #   endif
 371 #endif
 372
 373 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
 374
 375 /* It is very unlikely that anyone will try to use this with Perl 6
 376    (or greater), but who knows.
 377  */
 378 #if PERL_REVISION != 5
 379 #       error ppport.h only works with Perl version 5
 380 #endif /* PERL_REVISION != 5 */
 381
 382 #ifndef ERRSV
 383 #       define ERRSV perl_get_sv("@",FALSE)
 384 #endif
 385
 386 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
 387 /* Replace: 1 */
 388 #       define PL_Sv            Sv
 389 #       define PL_compiling     compiling
 390 #       define PL_copline       copline
 391 #       define PL_curcop        curcop
 392 #       define PL_curstash      curstash
 393 #       define PL_defgv         defgv
 394 #       define PL_dirty         dirty
 395 #       define PL_dowarn        dowarn
 396 #       define PL_hints         hints
 397 #       define PL_na            na
 398 #       define PL_perldb        perldb
 399 #       define PL_rsfp_filters  rsfp_filters
 400 #       define PL_rsfpv         rsfp
 401 #       define PL_stdingv       stdingv
 402 #       define PL_sv_no         sv_no
 403 #       define PL_sv_undef      sv_undef
 404 #       define PL_sv_yes        sv_yes
 405 /* Replace: 0 */
 406 #endif
 407
 408 #ifdef HASATTRIBUTE
 409 #  if defined(__GNUC__) && defined(__cplusplus)
 410 #    define PERL_UNUSED_DECL
 411 #  else
 412 #    define PERL_UNUSED_DECL __attribute__((unused))
 413 #  endif
 414 #else
 415 #  define PERL_UNUSED_DECL
 416 #endif
 417
 418 #ifndef dNOOP
 419 #  define NOOP (void)0
 420 #  define dNOOP extern int Perl___notused PERL_UNUSED_DECL
 421 #endif
 422
 423 #ifndef dTHR
 424 #  define dTHR          dNOOP
 425 #endif
 426
 427 #ifndef dTHX
 428 #  define dTHX          dNOOP
 429 #  define dTHXa(x)      dNOOP
 430 #  define dTHXoa(x)     dNOOP
 431 #endif
 432
 433 #ifndef pTHX
 434 #    define pTHX        void
 435 #    define pTHX_
 436 #    define aTHX
 437 #    define aTHX_
 438 #endif
 439
 440 /* IV could also be a quad (say, a long long), but Perls
 441  * capable of those should have IVSIZE already. */
 442 #if !defined(IVSIZE) && defined(LONGSIZE)
 443 #   define IVSIZE LONGSIZE
 444 #endif
 445 #ifndef IVSIZE
 446 #   define IVSIZE 4 /* A bold guess, but the best we can make. */
 447 #endif
 448
 449 #ifndef UVSIZE
 450 #   define UVSIZE IVSIZE
 451 #endif
 452
 453 #ifndef NVTYPE
 454 #   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
 455 #       define NVTYPE long double
 456 #   else
 457 #       define NVTYPE double
 458 #   endif
 459 typedef NVTYPE NV;
 460 #endif
 461
 462 #ifndef INT2PTR
 463
 464 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
 465 #  define PTRV                  UV
 466 #  define INT2PTR(any,d)        (any)(d)
 467 #else
 468 #  if PTRSIZE == LONGSIZE
 469 #    define PTRV                unsigned long
 470 #  else
 471 #    define PTRV                unsigned
 472 #  endif
 473 #  define INT2PTR(any,d)        (any)(PTRV)(d)
 474 #endif
 475 #define NUM2PTR(any,d)  (any)(PTRV)(d)
 476 #define PTR2IV(p)       INT2PTR(IV,p)
 477 #define PTR2UV(p)       INT2PTR(UV,p)
 478 #define PTR2NV(p)       NUM2PTR(NV,p)
 479 #if PTRSIZE == LONGSIZE
 480 #  define PTR2ul(p)     (unsigned long)(p)
 481 #else
 482 #  define PTR2ul(p)     INT2PTR(unsigned long,p)
 483 #endif
 484
 485 #endif /* !INT2PTR */
 486
 487 #ifndef boolSV
 488 #       define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
 489 #endif
 490
 491 #ifndef gv_stashpvn
 492 #       define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
 493 #endif
 494
 495 #ifndef newSVpvn
 496 #       define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
 497 #endif
 498
 499 #ifndef newRV_inc
 500 /* Replace: 1 */
 501 #       define newRV_inc(sv) newRV(sv)
 502 /* Replace: 0 */
 503 #endif
 504
 505 /* DEFSV appears first in 5.004_56 */
 506 #ifndef DEFSV
 507 #  define DEFSV GvSV(PL_defgv)
 508 #endif
 509
 510 #ifndef SAVE_DEFSV
 511 #    define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
 512 #endif
 513
 514 #ifndef newRV_noinc
 515 #  ifdef __GNUC__
 516 #    define newRV_noinc(sv)               \
 517       ({                                  \
 518           SV *nsv = (SV*)newRV(sv);       \
 519           SvREFCNT_dec(sv);               \
 520           nsv;                            \
 521       })
 522 #  else
 523 #    if defined(USE_THREADS)
 524 static SV * newRV_noinc (SV * sv)
 525 {
 526           SV *nsv = (SV*)newRV(sv);
 527           SvREFCNT_dec(sv);
 528           return nsv;
 529 }
 530 #    else
 531 #      define newRV_noinc(sv)    \
 532         (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
 533 #    endif
 534 #  endif
 535 #endif
 536
 537 /* Provide: newCONSTSUB */
 538
 539 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
 540 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
 541
 542 #if defined(NEED_newCONSTSUB)
 543 static
 544 #else
 545 extern void newCONSTSUB(HV * stash, char * name, SV *sv);
 546 #endif
 547
 548 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
 549 void
 550 newCONSTSUB(stash,name,sv)
 551 HV *stash;
 552 char *name;
 553 SV *sv;
 554 {
 555         U32 oldhints = PL_hints;
 556         HV *old_cop_stash = PL_curcop->cop_stash;
 557         HV *old_curstash = PL_curstash;
 558         line_t oldline = PL_curcop->cop_line;
 559         PL_curcop->cop_line = PL_copline;
 560
 561         PL_hints &= ~HINT_BLOCK_SCOPE;
 562         if (stash)
 563                 PL_curstash = PL_curcop->cop_stash = stash;
 564
 565         newSUB(
 566
 567 #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
 568      /* before 5.003_22 */
 569                 start_subparse(),
 570 #else
 571 #  if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
 572      /* 5.003_22 */
 573                 start_subparse(0),
 574 #  else
 575      /* 5.003_23  onwards */
 576                 start_subparse(FALSE, 0),
 577 #  endif
 578 #endif
 579
 580                 newSVOP(OP_CONST, 0, newSVpv(name,0)),
 581                 newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
 582                 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
 583         );
 584
 585         PL_hints = oldhints;
 586         PL_curcop->cop_stash = old_cop_stash;
 587         PL_curstash = old_curstash;
 588         PL_curcop->cop_line = oldline;
 589 }
 590 #endif
 591
 592 #endif /* newCONSTSUB */
 593
 594 #ifndef START_MY_CXT
 595
 596 /*
 597  * Boilerplate macros for initializing and accessing interpreter-local
 598  * data from C.  All statics in extensions should be reworked to use
 599  * this, if you want to make the extension thread-safe.  See ext/re/re.xs
 600  * for an example of the use of these macros.
 601  *
 602  * Code that uses these macros is responsible for the following:
 603  * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
 604  * 2. Declare a typedef named my_cxt_t that is a structure that contains
 605  *    all the data that needs to be interpreter-local.
 606  * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
 607  * 4. Use the MY_CXT_INIT macro such that it is called exactly once
 608  *    (typically put in the BOOT: section).
 609  * 5. Use the members of the my_cxt_t structure everywhere as
 610  *    MY_CXT.member.
 611  * 6. Use the dMY_CXT macro (a declaration) in all the functions that
 612  *    access MY_CXT.
 613  */
 614
 615 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
 616     defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
 617
 618 /* This must appear in all extensions that define a my_cxt_t structure,
 619  * right after the definition (i.e. at file scope).  The non-threads
 620  * case below uses it to declare the data as static. */
 621 #define START_MY_CXT
 622
 623 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
 624 /* Fetches the SV that keeps the per-interpreter data. */
 625 #define dMY_CXT_SV \
 626         SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
 627 #else /* >= perl5.004_68 */
 628 #define dMY_CXT_SV \
 629         SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,             \
 630                                   sizeof(MY_CXT_KEY)-1, TRUE)
 631 #endif /* < perl5.004_68 */
 632
 633 /* This declaration should be used within all functions that use the
 634  * interpreter-local data. */
 635 #define dMY_CXT \
 636         dMY_CXT_SV;                                                     \
 637         my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
 638
 639 /* Creates and zeroes the per-interpreter data.
 640  * (We allocate my_cxtp in a Perl SV so that it will be released when
 641  * the interpreter goes away.) */
 642 #define MY_CXT_INIT \
 643         dMY_CXT_SV;                                                     \
 644         /* newSV() allocates one more than needed */                    \
 645         my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
 646         Zero(my_cxtp, 1, my_cxt_t);                                     \
 647         sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
 648
 649 /* This macro must be used to access members of the my_cxt_t structure.
 650  * e.g. MYCXT.some_data */
 651 #define MY_CXT          (*my_cxtp)
 652
 653 /* Judicious use of these macros can reduce the number of times dMY_CXT
 654  * is used.  Use is similar to pTHX, aTHX etc. */
 655 #define pMY_CXT         my_cxt_t *my_cxtp
 656 #define pMY_CXT_        pMY_CXT,
 657 #define _pMY_CXT        ,pMY_CXT
 658 #define aMY_CXT         my_cxtp
 659 #define aMY_CXT_        aMY_CXT,
 660 #define _aMY_CXT        ,aMY_CXT
 661
 662 #else /* single interpreter */
 663
 664 #define START_MY_CXT    static my_cxt_t my_cxt;
 665 #define dMY_CXT_SV      dNOOP
 666 #define dMY_CXT         dNOOP
 667 #define MY_CXT_INIT     NOOP
 668 #define MY_CXT          my_cxt
 669
 670 #define pMY_CXT         void
 671 #define pMY_CXT_
 672 #define _pMY_CXT
 673 #define aMY_CXT
 674 #define aMY_CXT_
 675 #define _aMY_CXT
 676
 677 #endif
 678
 679 #endif /* START_MY_CXT */
 680
 681 #ifndef IVdf
 682 #  if IVSIZE == LONGSIZE
 683 #       define  IVdf            "ld"
 684 #       define  UVuf            "lu"
 685 #       define  UVof            "lo"
 686 #       define  UVxf            "lx"
 687 #       define  UVXf            "lX"
 688 #   else
 689 #       if IVSIZE == INTSIZE
 690 #           define      IVdf    "d"
 691 #           define      UVuf    "u"
 692 #           define      UVof    "o"
 693 #           define      UVxf    "x"
 694 #           define      UVXf    "X"
 695 #       endif
 696 #   endif
 697 #endif
 698
 699 #ifndef NVef
 700 #   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
 701         defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
 702 #       define NVef             PERL_PRIeldbl
 703 #       define NVff             PERL_PRIfldbl
 704 #       define NVgf             PERL_PRIgldbl
 705 #   else
 706 #       define NVef             "e"
 707 #       define NVff             "f"
 708 #       define NVgf             "g"
 709 #   endif
 710 #endif
 711
 712 #ifndef AvFILLp                 /* Older perls (<=5.003) lack AvFILLp */
 713 #   define AvFILLp AvFILL
 714 #endif
 715
 716 #ifdef SvPVbyte
 717 #   if PERL_REVISION == 5 && PERL_VERSION < 7
 718        /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
 719 #       undef SvPVbyte
 720 #       define SvPVbyte(sv, lp) \
 721           ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
 722            ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
 723        static char *
 724        my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
 725        {
 726            sv_utf8_downgrade(sv,0);
 727            return SvPV(sv,*lp);
 728        }
 729 #   endif
 730 #else
 731 #   define SvPVbyte SvPV
 732 #endif
 733
 734 #ifndef SvPV_nolen
 735 #   define SvPV_nolen(sv) \
 736         ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
 737          ? SvPVX(sv) : sv_2pv_nolen(sv))
 738     static char *
 739     sv_2pv_nolen(pTHX_ register SV *sv)
 740     {
 741         STRLEN n_a;
 742         return sv_2pv(sv, &n_a);
 743     }
 744 #endif
 745
 746 #endif /* _P_P_PORTABILITY_H_ */
 747
 748 /* End of File ppport.h */