[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / PPPort.pm


package Devel::PPPort;

=head1 NAME

Perl/Pollution/Portability

=head1 SYNOPSIS

    Devel::PPPort::WriteFile() ; # defaults to ./ppport.h
    Devel::PPPort::WriteFile('someheader.h') ;

=head1 DESCRIPTION

Perl has changed over time, gaining new features, new functions,
increasing its flexibility, and reducing the impact on the C namespace
environment (reduced pollution). The header file, typicaly C<ppport.h>,
written by this module attempts to bring some of the newer Perl
features to older versions of Perl, so that you can worry less about
keeping track of old releases, but users can still reap the benefit.
 
Why you should use C<ppport.h> in modern code: so that your code will work
with the widest range of Perl interpreters possible, without significant
additional work.

Why you should attempt older code to fully use C<ppport.h>: because
the reduced pollution of newer Perl versions is an important thing, so
important that the old polluting ways of original Perl modules will not be
supported very far into the future, and your module will almost certainly
break! By adapting to it now, you'll gained compatibility and a sense of
having done the electronic ecology some good.

How to use ppport.h: Don't direct the user to download C<Devel::PPPort>,
and don't make C<ppport.h> optional. Rather, just take the most recent
copy of C<ppport.h> that you can find (probably in C<Devel::PPPort>
on CPAN), copy it into your project, adjust your project to use it,
and distribute the header along with your module.

C<Devel::PPPort> contains a single function, called C<WriteFile>. It's
purpose is to write a 'C' header file that is used when writing XS
modules. The file contains a series of macros that allow XS modules to
be built using older versions of Perl.

This module is used by h2xs to write the file F<ppport.h>. 

=head2 WriteFile

C<WriteFile> takes a zero or one parameters. When called with one
parameter it expects to be passed a filename. When called with no
parameters, it defults to the filename C<./pport.h>.

The function returns TRUE if the file was written successfully. Otherwise
it returns FALSE.

=head1 ppport.h

The file written by this module, typically C<ppport.h>, provides access
to the following Perl API if not already available (and in some cases [*]
even if available, access to a fixed interface):

    aMY_CXT
    aMY_CXT_
    _aMY_CXT
    aTHX
    aTHX_
    AvFILLp
    boolSV(b)
    DEFSV
    dMY_CXT	
    dMY_CXT_SV
    dNOOP
    dTHR
    dTHX
    dTHXa
    dTHXoa
    ERRSV
    gv_stashpvn(str,len,flags)
    INT2PTR(type,int)
    IVdf
    MY_CXT
    MY_CXT_INIT
    newCONSTSUB(stash,name,sv)
    newRV_inc(sv)
    newRV_noinc(sv)
    newSVpvn(data,len)
    NOOP
    NV 
    NVef
    NVff
    NVgf
    PERL_REVISION
    PERL_SUBVERSION
    PERL_UNUSED_DECL
    PERL_UNUSED_DECL
    PERL_VERSION
    PL_compiling
    PL_copline
    PL_curcop
    PL_curstash
    PL_defgv
    PL_dirty
    PL_hints
    PL_na
    PL_perldb
    PL_rsfp_filters
    PL_rsfpv
    PL_stdingv
    PL_Sv
    PL_sv_no
    PL_sv_undef
    PL_sv_yes
    pMY_CXT
    pMY_CXT_
    _pMY_CXT
    pTHX
    pTHX_
    PTR2IV(ptr)
    PTR2NV(ptr)
    PTR2ul(ptr)
    PTR2UV(ptr)
    SAVE_DEFSV
    START_MY_CXT
    SvPVbyte(sv,lp) [*]
    UVof
    UVSIZE
    UVuf
    UVxf
    UVXf

=head1 AUTHOR

Version 1.x of Devel::PPPort was written by Kenneth Albanowski.

Version 2.x was ported to the Perl core by Paul Marquess.

=head1 SEE ALSO

See L<h2xs>.

=cut


package Devel::PPPort;

require Exporter;
require DynaLoader;
#use warnings;
use strict;
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data );

$VERSION = "2.0002";

@ISA = qw(Exporter DynaLoader);
@EXPORT =  qw();
# Other items we are prepared to export if requested
@EXPORT_OK = qw( );

bootstrap Devel::PPPort;

package Devel::PPPort;

{
    local $/ = undef;
    $data = <DATA> ;
    my $now = localtime;
    my $pkg = __PACKAGE__;
    $data =~ s/__VERSION__/$VERSION/g;
    $data =~ s/__DATE__/$now/g;
    $data =~ s/__PKG__/$pkg/g;
}

sub WriteFile
{
    my $file = shift || 'ppport.h' ;

    open F, ">$file" || return undef ;
    print F $data ;
    close F;

    return 1 ;
}

1;

__DATA__;

/* ppport.h -- Perl/Pollution/Portability Version __VERSION__ 
 *
 * Automatically Created by __PKG__ on __DATE__ 
 *
 * Do NOT edit this file directly! -- Edit PPPort.pm instead.
 *
 * Version 2.x, Copyright (C) 2001, Paul Marquess.
 * Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
 * This code may be used and distributed under the same license as any
 * version of Perl.
 * 
 * This version of ppport.h is designed to support operation with Perl
 * installations back to 5.004, and has been tested up to 5.8.0.
 *
 * If this version of ppport.h is failing during the compilation of this
 * module, please check if a newer version of Devel::PPPort is available
 * on CPAN before sending a bug report.
 *
 * If you are using the latest version of Devel::PPPort and it is failing
 * during compilation of this module, please send a report to perlbug@perl.com
 *
 * Include all following information:
 *
 *  1. The complete output from running "perl -V"
 *
 *  2. This file.
 *
 *  3. The name & version of the module you were trying to build.
 *
 *  4. A full log of the build that failed.
 *
 *  5. Any other information that you think could be relevant.
 *
 *
 * For the latest version of this code, please retreive the Devel::PPPort
 * module from CPAN.
 * 
 */

/*
 * In order for a Perl extension module to be as portable as possible
 * across differing versions of Perl itself, certain steps need to be taken.
 * Including this header is the first major one, then using dTHR is all the
 * appropriate places and using a PL_ prefix to refer to global Perl
 * variables is the second.
 *
 */


/* If you use one of a few functions that were not present in earlier
 * versions of Perl, please add a define before the inclusion of ppport.h
 * for a static include, or use the GLOBAL request in a single module to
 * produce a global definition that can be referenced from the other
 * modules.
 * 
 * Function:            Static define:           Extern define:
 * newCONSTSUB()        NEED_newCONSTSUB         NEED_newCONSTSUB_GLOBAL
 *
 */
 

/* To verify whether ppport.h is needed for your module, and whether any
 * special defines should be used, ppport.h can be run through Perl to check
 * your source code. Simply say:
 * 
 * 	perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
 * 
 * The result will be a list of patches suggesting changes that should at
 * least be acceptable, if not necessarily the most efficient solution, or a
 * fix for all possible problems. It won't catch where dTHR is needed, and
 * doesn't attempt to account for global macro or function definitions,
 * nested includes, typemaps, etc.
 * 
 * In order to test for the need of dTHR, please try your module under a
 * recent version of Perl that has threading compiled-in.
 *
 */ 


/*
#!/usr/bin/perl
@ARGV = ("*.xs") if !@ARGV;
%badmacros = %funcs = %macros = (); $replace = 0;
foreach (<DATA>) {
	$funcs{$1} = 1 if /Provide:\s+(\S+)/;
	$macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
	$replace = $1 if /Replace:\s+(\d+)/;
	$badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
	$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
}
foreach $filename (map(glob($_),@ARGV)) {
	unless (open(IN, "<$filename")) {
		warn "Unable to read from $file: $!\n";
		next;
	}
	print "Scanning $filename...\n";
	$c = ""; while (<IN>) { $c .= $_; } close(IN);
	$need_include = 0; %add_func = (); $changes = 0;
	$has_include = ($c =~ /#.*include.*ppport/m);

	foreach $func (keys %funcs) {
		if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
			if ($c !~ /\b$func\b/m) {
				print "If $func isn't needed, you don't need to request it.\n" if
				$changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
			} else {
				print "Uses $func\n";
				$need_include = 1;
			}
		} else {
			if ($c =~ /\b$func\b/m) {
				$add_func{$func} =1 ;
				print "Uses $func\n";
				$need_include = 1;
			}
		}
	}

	if (not $need_include) {
		foreach $macro (keys %macros) {
			if ($c =~ /\b$macro\b/m) {
				print "Uses $macro\n";
				$need_include = 1;
			}
		}
	}

	foreach $badmacro (keys %badmacros) {
		if ($c =~ /\b$badmacro\b/m) {
			$changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
			print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
			$need_include = 1;
		}
	}
	
	if (scalar(keys %add_func) or $need_include != $has_include) {
		if (!$has_include) {
			$inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
			       "#include \"ppport.h\"\n";
			$c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
		} elsif (keys %add_func) {
			$inc = join('',map("#define NEED_$_\n", sort keys %add_func));
			$c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
		}
		if (!$need_include) {
			print "Doesn't seem to need ppport.h.\n";
			$c =~ s/^.*#.*include.*ppport.*\n//m;
		}
		$changes++;
	}
	
	if ($changes) {
		open(OUT,">/tmp/ppport.h.$$");
		print OUT $c;
		close(OUT);
		open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
		while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
		close(DIFF);
		unlink("/tmp/ppport.h.$$");
	} else {
		print "Looks OK\n";
	}
}
__DATA__
*/

#ifndef _P_P_PORTABILITY_H_
#define _P_P_PORTABILITY_H_

#ifndef PERL_REVISION
#   ifndef __PATCHLEVEL_H_INCLUDED__
#       include "patchlevel.h"
#   endif
#   ifndef PERL_REVISION
#	define PERL_REVISION	(5)
        /* Replace: 1 */
#       define PERL_VERSION	PATCHLEVEL
#       define PERL_SUBVERSION	SUBVERSION
        /* Replace PERL_PATCHLEVEL with PERL_VERSION */
        /* Replace: 0 */
#   endif
#endif

#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)

/* It is very unlikely that anyone will try to use this with Perl 6 
   (or greater), but who knows.
 */
#if PERL_REVISION != 5
#	error ppport.h only works with Perl version 5
#endif /* PERL_REVISION != 5 */

#ifndef ERRSV
#	define ERRSV perl_get_sv("@",FALSE)
#endif

#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
/* Replace: 1 */
#	define PL_Sv		Sv
#	define PL_compiling	compiling
#	define PL_copline	copline
#	define PL_curcop	curcop
#	define PL_curstash	curstash
#	define PL_defgv		defgv
#	define PL_dirty		dirty
#	define PL_dowarn	dowarn
#	define PL_hints		hints
#	define PL_na		na
#	define PL_perldb	perldb
#	define PL_rsfp_filters	rsfp_filters
#	define PL_rsfpv		rsfp
#	define PL_stdingv	stdingv
#	define PL_sv_no		sv_no
#	define PL_sv_undef	sv_undef
#	define PL_sv_yes	sv_yes
/* Replace: 0 */
#endif

#ifdef HASATTRIBUTE
#  if defined(__GNUC__) && defined(__cplusplus)
#    define PERL_UNUSED_DECL
#  else
#    define PERL_UNUSED_DECL __attribute__((unused))
#  endif
#else
#  define PERL_UNUSED_DECL
#endif

#ifndef dNOOP
#  define NOOP (void)0
#  define dNOOP extern int Perl___notused PERL_UNUSED_DECL
#endif

#ifndef dTHR
#  define dTHR          dNOOP
#endif

#ifndef dTHX
#  define dTHX          dNOOP
#  define dTHXa(x)      dNOOP
#  define dTHXoa(x)     dNOOP
#endif

#ifndef pTHX
#    define pTHX	void
#    define pTHX_
#    define aTHX
#    define aTHX_
#endif         

#ifndef PTR2IV
#    define PTR2IV(d)   (IV)(d)
#endif
 
#ifndef INT2PTR
#    define INT2PTR(any,d)      (any)(d)
#endif

#ifndef boolSV
#	define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#endif

#ifndef gv_stashpvn
#	define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
#endif

#ifndef newSVpvn
#	define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
#endif

#ifndef newRV_inc
/* Replace: 1 */
#	define newRV_inc(sv) newRV(sv)
/* Replace: 0 */
#endif

/* DEFSV appears first in 5.004_56 */
#ifndef DEFSV
#  define DEFSV	GvSV(PL_defgv)
#endif

#ifndef SAVE_DEFSV
#    define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#endif

#ifndef newRV_noinc
#  ifdef __GNUC__
#    define newRV_noinc(sv)               \
      ({                                  \
          SV *nsv = (SV*)newRV(sv);       \
          SvREFCNT_dec(sv);               \
          nsv;                            \
      })
#  else
#    if defined(USE_THREADS)
static SV * newRV_noinc (SV * sv)
{
          SV *nsv = (SV*)newRV(sv);       
          SvREFCNT_dec(sv);               
          return nsv;                     
}
#    else
#      define newRV_noinc(sv)    \
        (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
#    endif
#  endif
#endif

/* Provide: newCONSTSUB */

/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))

#if defined(NEED_newCONSTSUB)
static
#else
extern void newCONSTSUB(HV * stash, char * name, SV *sv);
#endif

#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
void
newCONSTSUB(stash,name,sv)
HV *stash;
char *name;
SV *sv;
{
	U32 oldhints = PL_hints;
	HV *old_cop_stash = PL_curcop->cop_stash;
	HV *old_curstash = PL_curstash;
	line_t oldline = PL_curcop->cop_line;
	PL_curcop->cop_line = PL_copline;

	PL_hints &= ~HINT_BLOCK_SCOPE;
	if (stash)
		PL_curstash = PL_curcop->cop_stash = stash;

	newSUB(

#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
     /* before 5.003_22 */
		start_subparse(),
#else
#  if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
     /* 5.003_22 */
     		start_subparse(0),
#  else
     /* 5.003_23  onwards */
     		start_subparse(FALSE, 0),
#  endif
#endif

		newSVOP(OP_CONST, 0, newSVpv(name,0)),
		newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
		newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
	);

	PL_hints = oldhints;
	PL_curcop->cop_stash = old_cop_stash;
	PL_curstash = old_curstash;
	PL_curcop->cop_line = oldline;
}
#endif

#endif /* newCONSTSUB */

#ifndef START_MY_CXT

/*
 * Boilerplate macros for initializing and accessing interpreter-local
 * data from C.  All statics in extensions should be reworked to use
 * this, if you want to make the extension thread-safe.  See ext/re/re.xs
 * for an example of the use of these macros.
 *
 * Code that uses these macros is responsible for the following:
 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
 * 2. Declare a typedef named my_cxt_t that is a structure that contains
 *    all the data that needs to be interpreter-local.
 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
 *    (typically put in the BOOT: section).
 * 5. Use the members of the my_cxt_t structure everywhere as
 *    MY_CXT.member.
 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
 *    access MY_CXT.
 */

#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
    defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)

/* This must appear in all extensions that define a my_cxt_t structure,
 * right after the definition (i.e. at file scope).  The non-threads
 * case below uses it to declare the data as static. */
#define START_MY_CXT

#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
/* Fetches the SV that keeps the per-interpreter data. */
#define dMY_CXT_SV \
	SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
#else /* >= perl5.004_68 */
#define dMY_CXT_SV \
	SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,		\
				  sizeof(MY_CXT_KEY)-1, TRUE)
#endif /* < perl5.004_68 */

/* This declaration should be used within all functions that use the
 * interpreter-local data. */
#define dMY_CXT	\
	dMY_CXT_SV;							\
	my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))

/* Creates and zeroes the per-interpreter data.
 * (We allocate my_cxtp in a Perl SV so that it will be released when
 * the interpreter goes away.) */
#define MY_CXT_INIT \
	dMY_CXT_SV;							\
	/* newSV() allocates one more than needed */			\
	my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
	Zero(my_cxtp, 1, my_cxt_t);					\
	sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))

/* This macro must be used to access members of the my_cxt_t structure.
 * e.g. MYCXT.some_data */
#define MY_CXT		(*my_cxtp)

/* Judicious use of these macros can reduce the number of times dMY_CXT
 * is used.  Use is similar to pTHX, aTHX etc. */
#define pMY_CXT		my_cxt_t *my_cxtp
#define pMY_CXT_	pMY_CXT,
#define _pMY_CXT	,pMY_CXT
#define aMY_CXT		my_cxtp
#define aMY_CXT_	aMY_CXT,
#define _aMY_CXT	,aMY_CXT

#else /* single interpreter */


#define START_MY_CXT	static my_cxt_t my_cxt;
#define dMY_CXT_SV	dNOOP
#define dMY_CXT		dNOOP
#define MY_CXT_INIT	NOOP
#define MY_CXT		my_cxt

#define pMY_CXT		void
#define pMY_CXT_
#define _pMY_CXT
#define aMY_CXT
#define aMY_CXT_
#define _aMY_CXT

#endif 

#endif /* START_MY_CXT */

#ifndef IVdf
#  if IVSIZE == LONGSIZE
#       define	IVdf		"ld"
#       define	UVuf		"lu"
#       define	UVof		"lo"
#       define	UVxf		"lx"
#       define	UVXf		"lX"
#   else
#       if IVSIZE == INTSIZE
#           define	IVdf	"d"
#           define	UVuf	"u"
#           define	UVof	"o"
#           define	UVxf	"x"
#           define	UVXf	"X"
#       endif
#   endif
#endif

#ifndef NVef
#   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
	defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ 
#       define NVef		PERL_PRIeldbl
#       define NVff		PERL_PRIfldbl
#       define NVgf		PERL_PRIgldbl
#   else
#       define NVef		"e"
#       define NVff		"f"
#       define NVgf		"g"
#   endif
#endif

#ifndef UVSIZE
#   define UVSIZE IVSIZE
#endif

#ifndef NVTYPE
#   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
#       define NVTYPE long double
#   else
#       define NVTYPE double
#   endif
typedef NVTYPE NV;
#endif

#ifndef INT2PTR

#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
#  define PTRV                  UV
#  define INT2PTR(any,d)        (any)(d)
#else
#  if PTRSIZE == LONGSIZE
#    define PTRV                unsigned long
#  else
#    define PTRV                unsigned
#  endif
#  define INT2PTR(any,d)        (any)(PTRV)(d)
#endif
#define NUM2PTR(any,d)  (any)(PTRV)(d)
#define PTR2IV(p)       INT2PTR(IV,p)
#define PTR2UV(p)       INT2PTR(UV,p)
#define PTR2NV(p)       NUM2PTR(NV,p)
#if PTRSIZE == LONGSIZE
#  define PTR2ul(p)     (unsigned long)(p)
#else
#  define PTR2ul(p)     INT2PTR(unsigned long,p)        
#endif

#endif /* !INT2PTR */

#ifndef AvFILLp			/* Older perls (<=5.003) lack AvFILLp */
#   define AvFILLp AvFILL
#endif

#ifdef SvPVbyte
#   if PERL_REVISION == 5 && PERL_VERSION < 7
       /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
#       undef SvPVbyte
#       define SvPVbyte(sv, lp) \
          ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
           ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
       static char *
       my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
       {   
           sv_utf8_downgrade(sv,0);
           return SvPV(sv,*lp);
       }
#   endif
#else
#   define SvPVbyte SvPV
#endif

#endif /* _P_P_PORTABILITY_H_ */

/* End of File ppport.h */
Commit	Line	Data
0a7c7f4f	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
44284200	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>.
0a7c7f4f	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
44284200	55	=head1 ppport.h
	56
	57	The file written by this module, typically C<ppport.h>, provides access
9e19d553	58	to the following Perl API if not already available (and in some cases [*]
9e19d553	59	even if available, access to a fixed interface):
44284200	60
9e19d553	61	aMY_CXT
	62	aMY_CXT_
	63	_aMY_CXT
	64	aTHX
	65	aTHX_
	66	AvFILLp
	67	boolSV(b)
44284200	68	DEFSV
9e19d553	69	dMY_CXT
	70	dMY_CXT_SV
	71	dNOOP
	72	dTHR
	73	dTHX
	74	dTHXa
	75	dTHXoa
44284200	76	ERRSV
9e19d553	77	gv_stashpvn(str,len,flags)
	78	INT2PTR(type,int)
	79	IVdf
44284200	80	MY_CXT
44284200	81	MY_CXT_INIT
9e19d553	82	newCONSTSUB(stash,name,sv)
	83	newRV_inc(sv)
	84	newRV_noinc(sv)
	85	newSVpvn(data,len)
44284200	86	NOOP
9e19d553	87	NV
	88	NVef
	89	NVff
	90	NVgf
44284200	91	PERL_REVISION
	92	PERL_SUBVERSION
	93	PERL_UNUSED_DECL
9e19d553	94	PERL_UNUSED_DECL
44284200	95	PERL_VERSION
44284200	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
9e19d553	108	PL_Sv
44284200	109	PL_sv_no
	110	PL_sv_undef
	111	PL_sv_yes
44284200	112	pMY_CXT
44284200	113	pMY_CXT_
9e19d553	114	_pMY_CXT
44284200	115	pTHX
44284200	116	pTHX_
9e19d553	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
44284200	129
0a7c7f4f	130	=head1 AUTHOR
0a7c7f4f	131
dbda3434	132	Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
0a7c7f4f	133
dbda3434	134	Version 2.x was ported to the Perl core by Paul Marquess.
0a7c7f4f	135
	136	=head1 SEE ALSO
	137
	138	See L<h2xs>.
	139
	140	=cut
	141
44284200	142
	143	package Devel::PPPort;
	144
	145	require Exporter;
	146	require DynaLoader;
0a7c7f4f	147	#use warnings;
0a7c7f4f	148	use strict;
44284200	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( );
0a7c7f4f	157
44284200	158	bootstrap Devel::PPPort;
	159
	160	package Devel::PPPort;
0a7c7f4f	161
	162	{
	163	local $/ = undef;
	164	$data = <DATA> ;
	165	my $now = localtime;
	166	my $pkg = __PACKAGE__;
dbda3434	167	$data =~ s/__VERSION__/$VERSION/g;
	168	$data =~ s/__DATE__/$now/g;
	169	$data =~ s/__PKG__/$pkg/g;
0a7c7f4f	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__;
0a7c7f4f	186
44284200	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	*/
0a7c7f4f	225
0a7c7f4f	226	/*
44284200	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	*/
0a7c7f4f	234
	235
	236	/* If you use one of a few functions that were not present in earlier
44284200	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	*/
0a7c7f4f	246
	247
	248	/* To verify whether ppport.h is needed for your module, and whether any
44284200	249	* special defines should be used, ppport.h can be run through Perl to check
	250	* your source code. Simply say:
	251	*
20d72259	252	* perl -x ppport.h .c .h .xs foo/bar.c [etc]
44284200	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	*/
0a7c7f4f	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 /^#\sdefine\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
44284200	353	#ifndef _P_P_PORTABILITY_H_
	354	#define _P_P_PORTABILITY_H_
	355
0a7c7f4f	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
44284200	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
0a7c7f4f	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
b9381339	392	# define PL_dowarn dowarn
0a7c7f4f	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
5a0bf5be	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
0a7c7f4f	430	#ifndef pTHX
5a0bf5be	431	# define pTHX void
0a7c7f4f	432	# define pTHX_
	433	# define aTHX
	434	# define aTHX_
	435	#endif
	436
	437	#ifndef PTR2IV
	438	# define PTR2IV(d) (IV)(d)
	439	#endif
	440
	441	#ifndef INT2PTR
	442	# define INT2PTR(any,d) (any)(d)
	443	#endif
	444
0a7c7f4f	445	#ifndef boolSV
	446	# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
	447	#endif
	448
	449	#ifndef gv_stashpvn
	450	# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
	451	#endif
	452
	453	#ifndef newSVpvn
	454	# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
	455	#endif
	456
	457	#ifndef newRV_inc
	458	/* Replace: 1 */
	459	# define newRV_inc(sv) newRV(sv)
	460	/* Replace: 0 */
	461	#endif
	462
	463	/* DEFSV appears first in 5.004_56 */
	464	#ifndef DEFSV
	465	# define DEFSV GvSV(PL_defgv)
	466	#endif
	467
	468	#ifndef SAVE_DEFSV
	469	# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
	470	#endif
	471
	472	#ifndef newRV_noinc
	473	# ifdef __GNUC__
	474	# define newRV_noinc(sv) \
	475	({ \
	476	SV nsv = (SV)newRV(sv); \
	477	SvREFCNT_dec(sv); \
	478	nsv; \
	479	})
	480	# else
9ede5bc8	481	# if defined(USE_THREADS)
0a7c7f4f	482	static SV * newRV_noinc (SV * sv)
	483	{
	484	SV nsv = (SV)newRV(sv);
	485	SvREFCNT_dec(sv);
	486	return nsv;
	487	}
	488	# else
	489	# define newRV_noinc(sv) \
97dc1cde	490	(PL_Sv=(SV)newRV(sv), SvREFCNT_dec(sv), (SV)PL_Sv)
0a7c7f4f	491	# endif
	492	# endif
	493	#endif
	494
	495	/* Provide: newCONSTSUB */
	496
	497	/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
	498	#if (PERL_VERSION < 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
	499
	500	#if defined(NEED_newCONSTSUB)
	501	static
	502	#else
c68a00c0	503	extern void newCONSTSUB(HV * stash, char * name, SV *sv);
0a7c7f4f	504	#endif
	505
	506	#if defined(NEED_newCONSTSUB) \|\| defined(NEED_newCONSTSUB_GLOBAL)
	507	void
	508	newCONSTSUB(stash,name,sv)
	509	HV *stash;
	510	char *name;
	511	SV *sv;
	512	{
	513	U32 oldhints = PL_hints;
	514	HV *old_cop_stash = PL_curcop->cop_stash;
	515	HV *old_curstash = PL_curstash;
	516	line_t oldline = PL_curcop->cop_line;
	517	PL_curcop->cop_line = PL_copline;
	518
	519	PL_hints &= ~HINT_BLOCK_SCOPE;
	520	if (stash)
	521	PL_curstash = PL_curcop->cop_stash = stash;
	522
	523	newSUB(
	524
	525	#if (PERL_VERSION < 3) \|\| ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
	526	/* before 5.003_22 */
	527	start_subparse(),
	528	#else
	529	# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
	530	/* 5.003_22 */
	531	start_subparse(0),
	532	# else
	533	/* 5.003_23 onwards */
	534	start_subparse(FALSE, 0),
	535	# endif
	536	#endif
	537
	538	newSVOP(OP_CONST, 0, newSVpv(name,0)),
	539	newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
	540	newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
	541	);
	542
	543	PL_hints = oldhints;
	544	PL_curcop->cop_stash = old_cop_stash;
	545	PL_curstash = old_curstash;
	546	PL_curcop->cop_line = oldline;
	547	}
	548	#endif
	549
	550	#endif /* newCONSTSUB */
	551
0a7c7f4f	552	#ifndef START_MY_CXT
	553
	554	/*
	555	* Boilerplate macros for initializing and accessing interpreter-local
	556	* data from C. All statics in extensions should be reworked to use
	557	* this, if you want to make the extension thread-safe. See ext/re/re.xs
	558	* for an example of the use of these macros.
	559	*
	560	* Code that uses these macros is responsible for the following:
	561	* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
	562	* 2. Declare a typedef named my_cxt_t that is a structure that contains
	563	* all the data that needs to be interpreter-local.
	564	* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
	565	* 4. Use the MY_CXT_INIT macro such that it is called exactly once
	566	* (typically put in the BOOT: section).
	567	* 5. Use the members of the my_cxt_t structure everywhere as
	568	* MY_CXT.member.
	569	* 6. Use the dMY_CXT macro (a declaration) in all the functions that
	570	* access MY_CXT.
	571	*/
	572
	573	#if defined(MULTIPLICITY) \|\| defined(PERL_OBJECT) \|\| \
	574	defined(PERL_CAPI) \|\| defined(PERL_IMPLICIT_CONTEXT)
	575
	576	/* This must appear in all extensions that define a my_cxt_t structure,
	577	* right after the definition (i.e. at file scope). The non-threads
	578	* case below uses it to declare the data as static. */
	579	#define START_MY_CXT
	580
44284200	581	#if (PERL_VERSION < 4 \|\| (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
0a7c7f4f	582	/* Fetches the SV that keeps the per-interpreter data. */
	583	#define dMY_CXT_SV \
	584	SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
	585	#else /* >= perl5.004_68 */
	586	#define dMY_CXT_SV \
	587	SV my_cxt_sv = hv_fetch(PL_modglobal, MY_CXT_KEY, \
	588	sizeof(MY_CXT_KEY)-1, TRUE)
	589	#endif /* < perl5.004_68 */
	590
	591	/* This declaration should be used within all functions that use the
	592	* interpreter-local data. */
	593	#define dMY_CXT \
	594	dMY_CXT_SV; \
	595	my_cxt_t my_cxtp = INT2PTR(my_cxt_t,SvUV(my_cxt_sv))
	596
	597	/* Creates and zeroes the per-interpreter data.
	598	* (We allocate my_cxtp in a Perl SV so that it will be released when
	599	* the interpreter goes away.) */
	600	#define MY_CXT_INIT \
	601	dMY_CXT_SV; \
	602	/* newSV() allocates one more than needed */ \
	603	my_cxt_t my_cxtp = (my_cxt_t)SvPVX(newSV(sizeof(my_cxt_t)-1));\
	604	Zero(my_cxtp, 1, my_cxt_t); \
	605	sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
	606
	607	/* This macro must be used to access members of the my_cxt_t structure.
	608	* e.g. MYCXT.some_data */
	609	#define MY_CXT (*my_cxtp)
	610
	611	/* Judicious use of these macros can reduce the number of times dMY_CXT
	612	* is used. Use is similar to pTHX, aTHX etc. */
	613	#define pMY_CXT my_cxt_t *my_cxtp
	614	#define pMY_CXT_ pMY_CXT,
	615	#define _pMY_CXT ,pMY_CXT
	616	#define aMY_CXT my_cxtp
	617	#define aMY_CXT_ aMY_CXT,
	618	#define _aMY_CXT ,aMY_CXT
	619
	620	#else /* single interpreter */
	621
0a7c7f4f	622
	623	#define START_MY_CXT static my_cxt_t my_cxt;
	624	#define dMY_CXT_SV dNOOP
	625	#define dMY_CXT dNOOP
	626	#define MY_CXT_INIT NOOP
	627	#define MY_CXT my_cxt
	628
	629	#define pMY_CXT void
	630	#define pMY_CXT_
	631	#define _pMY_CXT
	632	#define aMY_CXT
	633	#define aMY_CXT_
	634	#define _aMY_CXT
	635
	636	#endif
	637
	638	#endif /* START_MY_CXT */
	639
4b729f51	640	#ifndef IVdf
	641	# if IVSIZE == LONGSIZE
	642	# define IVdf "ld"
	643	# define UVuf "lu"
	644	# define UVof "lo"
	645	# define UVxf "lx"
	646	# define UVXf "lX"
	647	# else
	648	# if IVSIZE == INTSIZE
	649	# define IVdf "d"
	650	# define UVuf "u"
	651	# define UVof "o"
	652	# define UVxf "x"
	653	# define UVXf "X"
	654	# endif
	655	# endif
	656	#endif
	657
	658	#ifndef NVef
	659	# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
	660	defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
	661	# define NVef PERL_PRIeldbl
	662	# define NVff PERL_PRIfldbl
	663	# define NVgf PERL_PRIgldbl
	664	# else
	665	# define NVef "e"
	666	# define NVff "f"
	667	# define NVgf "g"
	668	# endif
	669	#endif
	670
	671	#ifndef UVSIZE
	672	# define UVSIZE IVSIZE
	673	#endif
	674
	675	#ifndef NVTYPE
	676	# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
	677	# define NVTYPE long double
	678	# else
	679	# define NVTYPE double
	680	# endif
	681	typedef NVTYPE NV;
	682	#endif
	683
	684	#ifndef INT2PTR
	685
	686	#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
	687	# define PTRV UV
	688	# define INT2PTR(any,d) (any)(d)
	689	#else
	690	# if PTRSIZE == LONGSIZE
	691	# define PTRV unsigned long
	692	# else
	693	# define PTRV unsigned
	694	# endif
	695	# define INT2PTR(any,d) (any)(PTRV)(d)
	696	#endif
	697	#define NUM2PTR(any,d) (any)(PTRV)(d)
	698	#define PTR2IV(p) INT2PTR(IV,p)
	699	#define PTR2UV(p) INT2PTR(UV,p)
	700	#define PTR2NV(p) NUM2PTR(NV,p)
	701	#if PTRSIZE == LONGSIZE
	702	# define PTR2ul(p) (unsigned long)(p)
	703	#else
704	# define PTR2ul(p) INT2PTR(unsigned long,p)
705	#endif
706
707	#endif /* !INT2PTR */
708
709	#ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */
710	# define AvFILLp AvFILL
711	#endif
712
9e19d553	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
0a7c7f4f	731	#endif /* _P_P_PORTABILITY_H_ */
44284200	732
44284200	733	/* End of File ppport.h */