ext/Devel/PPPort/PPPort.pm

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