home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 December / PCpro_2006_12.ISO / ossdvd / server / Perl2 / lib / Devel / PPPort.pm < prev    next >
Encoding:
Perl POD Document  |  2002-10-22  |  19.8 KB  |  746 lines
  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 */
  746.