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