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