[perl5.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

This modules contains a single function, called C<WriteFile>. It is
used 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 primarily 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 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

#use warnings;
use strict;
use vars qw( $VERSION $data );

$VERSION = "2.0001";

{
    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__;
/* Perl/Pollution/Portability Version __VERSION__ */

/* Automatically Created by __PKG__ on __DATE__ */

/* Do NOT edit this file directly! -- edit PPPort.pm instead. */


#ifndef _P_P_PORTABILITY_H_
#define _P_P_PORTABILITY_H_

/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and
   distributed under the same license as any version of Perl. */
   
/* For the latest version of this code, please retreive the Devel::PPPort
   module from CPAN, contact the author at <kjahds@kjahds.com>, or check
   with the Perl maintainers. */
   
/* If you needed to customize this file for your project, please mention
   your changes, and visible alter the version number. */


/*
   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/*.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 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)

#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_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

#ifndef pTHX
#    define pTHX
#    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 dTHR
#  ifdef WIN32
#	define dTHR extern int Perl___notused
#  else
#	define dTHR extern int errno
#  endif
#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(CRIPPLED_CC) || 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_REVISION == 5 && \
    (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 */

#ifndef NOOP
#  define NOOP (void)0
#endif

#ifdef HASATTRIBUTE
#  define PERL_UNUSED_DECL __attribute__((unused))
#else
#  define PERL_UNUSED_DECL
#endif    

#ifndef dNOOP
#  define dNOOP extern int Perl___notused PERL_UNUSED_DECL
#endif

#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 */


#endif /* _P_P_PORTABILITY_H_ */
Commit	Line	Data
0a7c7f4f JH	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	This modules contains a single function, called C<WriteFile>. It is
	16	used to write a 'C' header file that is used when writing XS modules. The
	17	file contains a series of macros that allow XS modules to be built using
	18	older versions of Perl.
	19
	20	This module is primarily used by h2xs to write the file F<ppport.h>.
	21
	22	=head2 WriteFile
	23
	24	C<WriteFile> takes a zero or one parameters. When called with one
	25	parameter it expects to be passed a filename. When called with no
	26	parameters, it defults to the filename C<./pport.h>.
	27
	28	The function returns TRUE if the file was written successfully. Otherwise
	29	it returns FALSE.
	30
	31	=head1 AUTHOR
	32
dbda3434	33	Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
0a7c7f4f	34
dbda3434	35	Version 2.x was ported to the Perl core by Paul Marquess.
0a7c7f4f JH	36
	37	=head1 SEE ALSO
	38
	39	See L<h2xs>.
	40
	41	=cut
	42
	43	#use warnings;
	44	use strict;
	45	use vars qw( $VERSION $data );
	46
dbda3434	47	$VERSION = "2.0001";
0a7c7f4f JH	48
	49	{
	50	local $/ = undef;
	51	$data = <DATA> ;
	52	my $now = localtime;
	53	my $pkg = __PACKAGE__;
dbda3434 PM	54	$data =~ s/__VERSION__/$VERSION/g;
	55	$data =~ s/__DATE__/$now/g;
	56	$data =~ s/__PKG__/$pkg/g;
0a7c7f4f JH	57	}
	58
	59	sub WriteFile
	60	{
	61	my $file = shift \|\| 'ppport.h' ;
	62
	63	open F, ">$file" \|\| return undef ;
	64	print F $data ;
	65	close F;
	66
	67	return 1 ;
	68	}
	69
	70	1;
	71
	72	__DATA__;
	73	/* Perl/Pollution/Portability Version __VERSION__ */
	74
	75	/* Automatically Created by __PKG__ on __DATE__ */
	76
	77	/* Do NOT edit this file directly! -- edit PPPort.pm instead. */
	78
	79
	80	#ifndef _P_P_PORTABILITY_H_
	81	#define _P_P_PORTABILITY_H_
	82
	83	/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and
	84	distributed under the same license as any version of Perl. */
	85
	86	/* For the latest version of this code, please retreive the Devel::PPPort
	87	module from CPAN, contact the author at <kjahds@kjahds.com>, or check
	88	with the Perl maintainers. */
	89
	90	/* If you needed to customize this file for your project, please mention
	91	your changes, and visible alter the version number. */
	92
	93
	94	/*
	95	In order for a Perl extension module to be as portable as possible
	96	across differing versions of Perl itself, certain steps need to be taken.
	97	Including this header is the first major one, then using dTHR is all the
	98	appropriate places and using a PL_ prefix to refer to global Perl
	99	variables is the second.
	100	*/
	101
	102
	103	/* If you use one of a few functions that were not present in earlier
	104	versions of Perl, please add a define before the inclusion of ppport.h
	105	for a static include, or use the GLOBAL request in a single module to
	106	produce a global definition that can be referenced from the other
	107	modules.
	108
	109	Function: Static define: Extern define:
	110	newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
	111
	112	*/
	113
	114
	115	/* To verify whether ppport.h is needed for your module, and whether any
	116	special defines should be used, ppport.h can be run through Perl to check
	117	your source code. Simply say:
	118
	119	perl -x ppport.h .c .h .xs foo/.c [etc]
	120
121	The result will be a list of patches suggesting changes that should at
122	least be acceptable, if not necessarily the most efficient solution, or a
123	fix for all possible problems. It won't catch where dTHR is needed, and
124	doesn't attempt to account for global macro or function definitions,
125	nested includes, typemaps, etc.
126
127	In order to test for the need of dTHR, please try your module under a
128	recent version of Perl that has threading compiled-in.
129
130	*/
131
132
133	/*
134	#!/usr/bin/perl
135	@ARGV = ("*.xs") if !@ARGV;
136	%badmacros = %funcs = %macros = (); $replace = 0;
137	foreach (<DATA>) {
138	$funcs{$1} = 1 if /Provide:\s+(\S+)/;
139	$macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
140	$replace = $1 if /Replace:\s+(\d+)/;
141	$badmacros{$2}=$1 if $replace and /^#\sdefine\s+([a-zA-Z0-9_]+).?\s+([a-zA-Z0-9_]+)/;
142	$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
143	}
144	foreach $filename (map(glob($_),@ARGV)) {
145	unless (open(IN, "<$filename")) {
146	warn "Unable to read from $file: $!\n";
147	next;
148	}
149	print "Scanning $filename...\n";
150	$c = ""; while (<IN>) { $c .= $_; } close(IN);
151	$need_include = 0; %add_func = (); $changes = 0;
152	$has_include = ($c =~ /#.include.ppport/m);
153
154	foreach $func (keys %funcs) {
155	if ($c =~ /#.define.\bNEED_$func(_GLOBAL)?\b/m) {
156	if ($c !~ /\b$func\b/m) {
157	print "If $func isn't needed, you don't need to request it.\n" if
158	$changes += ($c =~ s/^.#.define.\bNEED_$func\b.\n//m);
159	} else {
160	print "Uses $func\n";
161	$need_include = 1;
162	}
163	} else {
164	if ($c =~ /\b$func\b/m) {
165	$add_func{$func} =1 ;
166	print "Uses $func\n";
167	$need_include = 1;
168	}
169	}
170	}
171
172	if (not $need_include) {
173	foreach $macro (keys %macros) {
174	if ($c =~ /\b$macro\b/m) {
175	print "Uses $macro\n";
176	$need_include = 1;
177	}
178	}
179	}
180
181	foreach $badmacro (keys %badmacros) {
182	if ($c =~ /\b$badmacro\b/m) {
183	$changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
184	print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
185	$need_include = 1;
186	}
187	}
188
189	if (scalar(keys %add_func) or $need_include != $has_include) {
190	if (!$has_include) {
191	$inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
192	"#include \"ppport.h\"\n";
193	$c = "$inc$c" unless $c =~ s/#.include.XSUB.*\n/$&$inc/m;
194	} elsif (keys %add_func) {
195	$inc = join('',map("#define NEED_$_\n", sort keys %add_func));
196	$c = "$inc$c" unless $c =~ s/^.#.include.ppport.$/$inc$&/m;
197	}
198	if (!$need_include) {
199	print "Doesn't seem to need ppport.h.\n";
200	$c =~ s/^.#.include.ppport.\n//m;
201	}
202	$changes++;
203	}
204
205	if ($changes) {
206	open(OUT,">/tmp/ppport.h.$$");
207	print OUT $c;
208	close(OUT);
209	open(DIFF, "diff -u $filename /tmp/ppport.h.$$\|");
210	while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
211	close(DIFF);
212	unlink("/tmp/ppport.h.$$");
213	} else {
214	print "Looks OK\n";
215	}
216	}
217	__DATA__
218	*/
219
220	#ifndef PERL_REVISION
221	# ifndef __PATCHLEVEL_H_INCLUDED__
222	# include "patchlevel.h"
223	# endif
224	# ifndef PERL_REVISION
225	# define PERL_REVISION (5)
226	/* Replace: 1 */
227	# define PERL_VERSION PATCHLEVEL
228	# define PERL_SUBVERSION SUBVERSION
229	/* Replace PERL_PATCHLEVEL with PERL_VERSION */
230	/* Replace: 0 */
231	# endif
232	#endif
233
234	#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
235
236	#ifndef ERRSV
237	# define ERRSV perl_get_sv("@",FALSE)
238	#endif
239
240	#if (PERL_VERSION < 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
241	/* Replace: 1 */
242	# define PL_Sv Sv
243	# define PL_compiling compiling
244	# define PL_copline copline
245	# define PL_curcop curcop
246	# define PL_curstash curstash
247	# define PL_defgv defgv
248	# define PL_dirty dirty
249	# define PL_hints hints
250	# define PL_na na
251	# define PL_perldb perldb
252	# define PL_rsfp_filters rsfp_filters
253	# define PL_rsfpv rsfp
254	# define PL_stdingv stdingv
255	# define PL_sv_no sv_no
256	# define PL_sv_undef sv_undef
257	# define PL_sv_yes sv_yes
258	/* Replace: 0 */
259	#endif
260
261	#ifndef pTHX
262	# define pTHX
263	# define pTHX_
264	# define aTHX
265	# define aTHX_
266	#endif
267
268	#ifndef PTR2IV
269	# define PTR2IV(d) (IV)(d)
270	#endif
271
272	#ifndef INT2PTR
273	# define INT2PTR(any,d) (any)(d)
274	#endif
275
276	#ifndef dTHR
277	# ifdef WIN32
278	# define dTHR extern int Perl___notused
279	# else
280	# define dTHR extern int errno
281	# endif
282	#endif
283
284	#ifndef boolSV
285	# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
286	#endif
287
288	#ifndef gv_stashpvn
289	# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
290	#endif
291
292	#ifndef newSVpvn
293	# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
294	#endif
295
296	#ifndef newRV_inc
297	/* Replace: 1 */
298	# define newRV_inc(sv) newRV(sv)
299	/* Replace: 0 */
300	#endif
301
302	/* DEFSV appears first in 5.004_56 */
303	#ifndef DEFSV
304	# define DEFSV GvSV(PL_defgv)
305	#endif
306
307	#ifndef SAVE_DEFSV
308	# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
309	#endif
310
311	#ifndef newRV_noinc
312	# ifdef __GNUC__
313	# define newRV_noinc(sv) \
314	({ \
315	SV nsv = (SV)newRV(sv); \
316	SvREFCNT_dec(sv); \
317	nsv; \
318	})
319	# else
320	# if defined(CRIPPLED_CC) \|\| defined(USE_THREADS)
321	static SV * newRV_noinc (SV * sv)
322	{
323	SV nsv = (SV)newRV(sv);
324	SvREFCNT_dec(sv);
325	return nsv;
326	}
327	# else
328	# define newRV_noinc(sv) \
97dc1cde	329	(PL_Sv=(SV)newRV(sv), SvREFCNT_dec(sv), (SV)PL_Sv)
0a7c7f4f JH	330	# endif
	331	# endif
	332	#endif
	333
	334	/* Provide: newCONSTSUB */
	335
	336	/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
	337	#if (PERL_VERSION < 4) \|\| ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
	338
	339	#if defined(NEED_newCONSTSUB)
	340	static
	341	#else
	342	extern void newCONSTSUB _((HV * stash, char * name, SV *sv));
	343	#endif
	344
	345	#if defined(NEED_newCONSTSUB) \|\| defined(NEED_newCONSTSUB_GLOBAL)
	346	void
	347	newCONSTSUB(stash,name,sv)
	348	HV *stash;
	349	char *name;
	350	SV *sv;
	351	{
	352	U32 oldhints = PL_hints;
	353	HV *old_cop_stash = PL_curcop->cop_stash;
	354	HV *old_curstash = PL_curstash;
	355	line_t oldline = PL_curcop->cop_line;
	356	PL_curcop->cop_line = PL_copline;
	357
	358	PL_hints &= ~HINT_BLOCK_SCOPE;
	359	if (stash)
	360	PL_curstash = PL_curcop->cop_stash = stash;
	361
	362	newSUB(
	363
	364	#if (PERL_VERSION < 3) \|\| ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
	365	/* before 5.003_22 */
	366	start_subparse(),
	367	#else
	368	# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
	369	/* 5.003_22 */
	370	start_subparse(0),
	371	# else
	372	/* 5.003_23 onwards */
	373	start_subparse(FALSE, 0),
	374	# endif
	375	#endif
	376
	377	newSVOP(OP_CONST, 0, newSVpv(name,0)),
	378	newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
	379	newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
	380	);
	381
	382	PL_hints = oldhints;
	383	PL_curcop->cop_stash = old_cop_stash;
	384	PL_curstash = old_curstash;
	385	PL_curcop->cop_line = oldline;
	386	}
	387	#endif
	388
	389	#endif /* newCONSTSUB */
	390
	391
	392	#ifndef START_MY_CXT
	393
394	/*
395	* Boilerplate macros for initializing and accessing interpreter-local
396	* data from C. All statics in extensions should be reworked to use
397	* this, if you want to make the extension thread-safe. See ext/re/re.xs
398	* for an example of the use of these macros.
399	*
400	* Code that uses these macros is responsible for the following:
401	* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
402	* 2. Declare a typedef named my_cxt_t that is a structure that contains
403	* all the data that needs to be interpreter-local.
404	* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
405	* 4. Use the MY_CXT_INIT macro such that it is called exactly once
406	* (typically put in the BOOT: section).
407	* 5. Use the members of the my_cxt_t structure everywhere as
408	* MY_CXT.member.
409	* 6. Use the dMY_CXT macro (a declaration) in all the functions that
410	* access MY_CXT.
411	*/
412
413	#if defined(MULTIPLICITY) \|\| defined(PERL_OBJECT) \|\| \
414	defined(PERL_CAPI) \|\| defined(PERL_IMPLICIT_CONTEXT)
415
416	/* This must appear in all extensions that define a my_cxt_t structure,
417	* right after the definition (i.e. at file scope). The non-threads
418	* case below uses it to declare the data as static. */
419	#define START_MY_CXT
420
421	#if PERL_REVISION == 5 && \
422	(PERL_VERSION < 4 \|\| (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
423	/* Fetches the SV that keeps the per-interpreter data. */
424	#define dMY_CXT_SV \
425	SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
426	#else /* >= perl5.004_68 */
427	#define dMY_CXT_SV \
428	SV my_cxt_sv = hv_fetch(PL_modglobal, MY_CXT_KEY, \
429	sizeof(MY_CXT_KEY)-1, TRUE)
430	#endif /* < perl5.004_68 */
431
432	/* This declaration should be used within all functions that use the
433	* interpreter-local data. */
434	#define dMY_CXT \
435	dMY_CXT_SV; \
436	my_cxt_t my_cxtp = INT2PTR(my_cxt_t,SvUV(my_cxt_sv))
437
438	/* Creates and zeroes the per-interpreter data.
439	* (We allocate my_cxtp in a Perl SV so that it will be released when
440	* the interpreter goes away.) */
441	#define MY_CXT_INIT \
442	dMY_CXT_SV; \
443	/* newSV() allocates one more than needed */ \
444	my_cxt_t my_cxtp = (my_cxt_t)SvPVX(newSV(sizeof(my_cxt_t)-1));\
445	Zero(my_cxtp, 1, my_cxt_t); \
446	sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
447
448	/* This macro must be used to access members of the my_cxt_t structure.
449	* e.g. MYCXT.some_data */
450	#define MY_CXT (*my_cxtp)
451
452	/* Judicious use of these macros can reduce the number of times dMY_CXT
453	* is used. Use is similar to pTHX, aTHX etc. */
454	#define pMY_CXT my_cxt_t *my_cxtp
455	#define pMY_CXT_ pMY_CXT,
456	#define _pMY_CXT ,pMY_CXT
457	#define aMY_CXT my_cxtp
458	#define aMY_CXT_ aMY_CXT,
459	#define _aMY_CXT ,aMY_CXT
460
461	#else /* single interpreter */
462
463	#ifndef NOOP
464	# define NOOP (void)0
465	#endif
466
467	#ifdef HASATTRIBUTE
468	# define PERL_UNUSED_DECL __attribute__((unused))
469	#else
470	# define PERL_UNUSED_DECL
471	#endif
472
473	#ifndef dNOOP
474	# define dNOOP extern int Perl___notused PERL_UNUSED_DECL
475	#endif
476
477	#define START_MY_CXT static my_cxt_t my_cxt;
478	#define dMY_CXT_SV dNOOP
479	#define dMY_CXT dNOOP
480	#define MY_CXT_INIT NOOP
481	#define MY_CXT my_cxt
482
483	#define pMY_CXT void
484	#define pMY_CXT_
485	#define _pMY_CXT
486	#define aMY_CXT
487	#define aMY_CXT_
488	#define _aMY_CXT
489
490	#endif
491
492	#endif /* START_MY_CXT */
493
494
495	#endif /* _P_P_PORTABILITY_H_ */