5 Devel::PPPort - Perl/Pollution/Portability
9 Devel::PPPort::WriteFile() ; # defaults to ./ppport.h
10 Devel::PPPort::WriteFile('someheader.h') ;
14 Perl has changed over time, gaining new features, new functions,
15 increasing its flexibility, and reducing the impact on the C namespace
16 environment (reduced pollution). The header file, typicaly C<ppport.h>,
17 written by this module attempts to bring some of the newer Perl
18 features to older versions of Perl, so that you can worry less about
19 keeping track of old releases, but users can still reap the benefit.
21 Why you should use C<ppport.h> in modern code: so that your code will work
22 with the widest range of Perl interpreters possible, without significant
25 Why you should attempt older code to fully use C<ppport.h>: because
26 the reduced pollution of newer Perl versions is an important thing, so
27 important that the old polluting ways of original Perl modules will not be
28 supported very far into the future, and your module will almost certainly
29 break! By adapting to it now, you'll gained compatibility and a sense of
30 having done the electronic ecology some good.
32 How to use ppport.h: Don't direct the user to download C<Devel::PPPort>,
33 and don't make C<ppport.h> optional. Rather, just take the most recent
34 copy of C<ppport.h> that you can find (probably in C<Devel::PPPort>
35 on CPAN), copy it into your project, adjust your project to use it,
36 and distribute the header along with your module.
38 C<Devel::PPPort> contains a single function, called C<WriteFile>. It's
39 purpose is to write a 'C' header file that is used when writing XS
40 modules. The file contains a series of macros that allow XS modules to
41 be built using older versions of Perl.
43 This module is used by h2xs to write the file F<ppport.h>.
47 C<WriteFile> takes a zero or one parameters. When called with one
48 parameter it expects to be passed a filename. When called with no
49 parameters, it defults to the filename C<./pport.h>.
51 The function returns TRUE if the file was written successfully. Otherwise
56 The file written by this module, typically C<ppport.h>, provides access
57 to the following Perl API if not already available (and in some cases [*]
58 even if available, access to a fixed interface):
89 gv_stashpvn(str,len,flags)
94 newCONSTSUB(stash,name,sv)
143 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
145 Version 2.x was ported to the Perl core by Paul Marquess.
154 package Devel::PPPort;
160 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data );
164 @ISA = qw(Exporter DynaLoader);
166 # Other items we are prepared to export if requested
169 bootstrap Devel::PPPort;
171 package Devel::PPPort;
177 my $pkg = __PACKAGE__;
178 $data =~ s/__VERSION__/$VERSION/g;
179 $data =~ s/__DATE__/$now/g;
180 $data =~ s/__PKG__/$pkg/g;
185 my $file = shift || 'ppport.h' ;
187 open F, ">$file" || return undef ;
198 /* ppport.h -- Perl/Pollution/Portability Version __VERSION__
200 * Automatically Created by __PKG__ on __DATE__
202 * Do NOT edit this file directly! -- Edit PPPort.pm instead.
204 * Version 2.x, Copyright (C) 2001, Paul Marquess.
205 * Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
206 * This code may be used and distributed under the same license as any
209 * This version of ppport.h is designed to support operation with Perl
210 * installations back to 5.004, and has been tested up to 5.8.1.
212 * If this version of ppport.h is failing during the compilation of this
213 * module, please check if a newer version of Devel::PPPort is available
214 * on CPAN before sending a bug report.
216 * If you are using the latest version of Devel::PPPort and it is failing
217 * during compilation of this module, please send a report to perlbug@perl.com
219 * Include all following information:
221 * 1. The complete output from running "perl -V"
225 * 3. The name & version of the module you were trying to build.
227 * 4. A full log of the build that failed.
229 * 5. Any other information that you think could be relevant.
232 * For the latest version of this code, please retreive the Devel::PPPort
238 * In order for a Perl extension module to be as portable as possible
239 * across differing versions of Perl itself, certain steps need to be taken.
240 * Including this header is the first major one, then using dTHR is all the
241 * appropriate places and using a PL_ prefix to refer to global Perl
242 * variables is the second.
247 /* If you use one of a few functions that were not present in earlier
248 * versions of Perl, please add a define before the inclusion of ppport.h
249 * for a static include, or use the GLOBAL request in a single module to
250 * produce a global definition that can be referenced from the other
253 * Function: Static define: Extern define:
254 * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
259 /* To verify whether ppport.h is needed for your module, and whether any
260 * special defines should be used, ppport.h can be run through Perl to check
261 * your source code. Simply say:
263 * perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
265 * The result will be a list of patches suggesting changes that should at
266 * least be acceptable, if not necessarily the most efficient solution, or a
267 * fix for all possible problems. It won't catch where dTHR is needed, and
268 * doesn't attempt to account for global macro or function definitions,
269 * nested includes, typemaps, etc.
271 * In order to test for the need of dTHR, please try your module under a
272 * recent version of Perl that has threading compiled-in.
279 @ARGV = ("*.xs") if !@ARGV;
280 %badmacros = %funcs = %macros = (); $replace = 0;
282 $funcs{$1} = 1 if /Provide:\s+(\S+)/;
283 $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
284 $replace = $1 if /Replace:\s+(\d+)/;
285 $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
286 $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
288 foreach $filename (map(glob($_),@ARGV)) {
289 unless (open(IN, "<$filename")) {
290 warn "Unable to read from $file: $!\n";
293 print "Scanning $filename...\n";
294 $c = ""; while (<IN>) { $c .= $_; } close(IN);
295 $need_include = 0; %add_func = (); $changes = 0;
296 $has_include = ($c =~ /#.*include.*ppport/m);
298 foreach $func (keys %funcs) {
299 if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
300 if ($c !~ /\b$func\b/m) {
301 print "If $func isn't needed, you don't need to request it.\n" if
302 $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
304 print "Uses $func\n";
308 if ($c =~ /\b$func\b/m) {
309 $add_func{$func} =1 ;
310 print "Uses $func\n";
316 if (not $need_include) {
317 foreach $macro (keys %macros) {
318 if ($c =~ /\b$macro\b/m) {
319 print "Uses $macro\n";
325 foreach $badmacro (keys %badmacros) {
326 if ($c =~ /\b$badmacro\b/m) {
327 $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
328 print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
333 if (scalar(keys %add_func) or $need_include != $has_include) {
335 $inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
336 "#include \"ppport.h\"\n";
337 $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
338 } elsif (keys %add_func) {
339 $inc = join('',map("#define NEED_$_\n", sort keys %add_func));
340 $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
342 if (!$need_include) {
343 print "Doesn't seem to need ppport.h.\n";
344 $c =~ s/^.*#.*include.*ppport.*\n//m;
350 open(OUT,">/tmp/ppport.h.$$");
353 open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
354 while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
356 unlink("/tmp/ppport.h.$$");
364 #ifndef _P_P_PORTABILITY_H_
365 #define _P_P_PORTABILITY_H_
367 #ifndef PERL_REVISION
368 # ifndef __PATCHLEVEL_H_INCLUDED__
369 # include <patchlevel.h>
371 # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
372 # include <could_not_find_Perl_patchlevel.h>
374 # ifndef PERL_REVISION
375 # define PERL_REVISION (5)
377 # define PERL_VERSION PATCHLEVEL
378 # define PERL_SUBVERSION SUBVERSION
379 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
384 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
386 /* It is very unlikely that anyone will try to use this with Perl 6
387 (or greater), but who knows.
389 #if PERL_REVISION != 5
390 # error ppport.h only works with Perl version 5
391 #endif /* PERL_REVISION != 5 */
394 # define ERRSV perl_get_sv("@",FALSE)
397 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
400 # define PL_compiling compiling
401 # define PL_copline copline
402 # define PL_curcop curcop
403 # define PL_curstash curstash
404 # define PL_defgv defgv
405 # define PL_dirty dirty
406 # define PL_dowarn dowarn
407 # define PL_hints hints
409 # define PL_perldb perldb
410 # define PL_rsfp_filters rsfp_filters
411 # define PL_rsfpv rsfp
412 # define PL_stdingv stdingv
413 # define PL_sv_no sv_no
414 # define PL_sv_undef sv_undef
415 # define PL_sv_yes sv_yes
420 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
421 # define PERL_UNUSED_DECL
423 # define PERL_UNUSED_DECL __attribute__((unused))
426 # define PERL_UNUSED_DECL
430 # define NOOP (void)0
431 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL
440 # define dTHXa(x) dNOOP
441 # define dTHXoa(x) dNOOP
451 /* IV could also be a quad (say, a long long), but Perls
452 * capable of those should have IVSIZE already. */
453 #if !defined(IVSIZE) && defined(LONGSIZE)
454 # define IVSIZE LONGSIZE
457 # define IVSIZE 4 /* A bold guess, but the best we can make. */
461 # define UVSIZE IVSIZE
465 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
466 # define NVTYPE long double
468 # define NVTYPE double
475 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
477 # define INT2PTR(any,d) (any)(d)
479 # if PTRSIZE == LONGSIZE
480 # define PTRV unsigned long
482 # define PTRV unsigned
484 # define INT2PTR(any,d) (any)(PTRV)(d)
486 #define NUM2PTR(any,d) (any)(PTRV)(d)
487 #define PTR2IV(p) INT2PTR(IV,p)
488 #define PTR2UV(p) INT2PTR(UV,p)
489 #define PTR2NV(p) NUM2PTR(NV,p)
490 #if PTRSIZE == LONGSIZE
491 # define PTR2ul(p) (unsigned long)(p)
493 # define PTR2ul(p) INT2PTR(unsigned long,p)
496 #endif /* !INT2PTR */
499 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
503 # define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
507 # define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
512 # define newRV_inc(sv) newRV(sv)
516 /* DEFSV appears first in 5.004_56 */
518 # define DEFSV GvSV(PL_defgv)
522 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
527 # define newRV_noinc(sv) \
529 SV *nsv = (SV*)newRV(sv); \
534 # if defined(USE_THREADS)
535 static SV * newRV_noinc (SV * sv)
537 SV *nsv = (SV*)newRV(sv);
542 # define newRV_noinc(sv) \
543 (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
548 /* Provide: newCONSTSUB */
550 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
551 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
553 #if defined(NEED_newCONSTSUB)
556 extern void newCONSTSUB(HV * stash, char * name, SV *sv);
559 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
561 newCONSTSUB(stash,name,sv)
566 U32 oldhints = PL_hints;
567 HV *old_cop_stash = PL_curcop->cop_stash;
568 HV *old_curstash = PL_curstash;
569 line_t oldline = PL_curcop->cop_line;
570 PL_curcop->cop_line = PL_copline;
572 PL_hints &= ~HINT_BLOCK_SCOPE;
574 PL_curstash = PL_curcop->cop_stash = stash;
578 #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
579 /* before 5.003_22 */
582 # if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
586 /* 5.003_23 onwards */
587 start_subparse(FALSE, 0),
591 newSVOP(OP_CONST, 0, newSVpv(name,0)),
592 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
593 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
597 PL_curcop->cop_stash = old_cop_stash;
598 PL_curstash = old_curstash;
599 PL_curcop->cop_line = oldline;
603 #endif /* newCONSTSUB */
608 * Boilerplate macros for initializing and accessing interpreter-local
609 * data from C. All statics in extensions should be reworked to use
610 * this, if you want to make the extension thread-safe. See ext/re/re.xs
611 * for an example of the use of these macros.
613 * Code that uses these macros is responsible for the following:
614 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
615 * 2. Declare a typedef named my_cxt_t that is a structure that contains
616 * all the data that needs to be interpreter-local.
617 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
618 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
619 * (typically put in the BOOT: section).
620 * 5. Use the members of the my_cxt_t structure everywhere as
622 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
626 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
627 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
629 /* This must appear in all extensions that define a my_cxt_t structure,
630 * right after the definition (i.e. at file scope). The non-threads
631 * case below uses it to declare the data as static. */
634 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
635 /* Fetches the SV that keeps the per-interpreter data. */
637 SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
638 #else /* >= perl5.004_68 */
640 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
641 sizeof(MY_CXT_KEY)-1, TRUE)
642 #endif /* < perl5.004_68 */
644 /* This declaration should be used within all functions that use the
645 * interpreter-local data. */
648 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
650 /* Creates and zeroes the per-interpreter data.
651 * (We allocate my_cxtp in a Perl SV so that it will be released when
652 * the interpreter goes away.) */
653 #define MY_CXT_INIT \
655 /* newSV() allocates one more than needed */ \
656 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
657 Zero(my_cxtp, 1, my_cxt_t); \
658 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
660 /* This macro must be used to access members of the my_cxt_t structure.
661 * e.g. MYCXT.some_data */
662 #define MY_CXT (*my_cxtp)
664 /* Judicious use of these macros can reduce the number of times dMY_CXT
665 * is used. Use is similar to pTHX, aTHX etc. */
666 #define pMY_CXT my_cxt_t *my_cxtp
667 #define pMY_CXT_ pMY_CXT,
668 #define _pMY_CXT ,pMY_CXT
669 #define aMY_CXT my_cxtp
670 #define aMY_CXT_ aMY_CXT,
671 #define _aMY_CXT ,aMY_CXT
673 #else /* single interpreter */
675 #define START_MY_CXT static my_cxt_t my_cxt;
676 #define dMY_CXT_SV dNOOP
677 #define dMY_CXT dNOOP
678 #define MY_CXT_INIT NOOP
679 #define MY_CXT my_cxt
690 #endif /* START_MY_CXT */
693 # if IVSIZE == LONGSIZE
700 # if IVSIZE == INTSIZE
711 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
712 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
713 # define NVef PERL_PRIeldbl
714 # define NVff PERL_PRIfldbl
715 # define NVgf PERL_PRIgldbl
723 #ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */
724 # define AvFILLp AvFILL
728 # if PERL_REVISION == 5 && PERL_VERSION < 7
729 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
731 # define SvPVbyte(sv, lp) \
732 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
733 ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
735 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
737 sv_utf8_downgrade(sv,0);
742 # define SvPVbyte SvPV
746 # define SvPV_nolen(sv) \
747 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
748 ? SvPVX(sv) : sv_2pv_nolen(sv))
750 sv_2pv_nolen(pTHX_ register SV *sv)
753 return sv_2pv(sv, &n_a);
758 # define get_cv(name,create) perl_get_cv(name,create)
762 # define get_sv(name,create) perl_get_sv(name,create)
766 # define get_av(name,create) perl_get_av(name,create)
770 # define get_hv(name,create) perl_get_hv(name,create)
774 # define call_argv perl_call_argv
778 # define call_method perl_call_method
782 # define call_pv perl_call_pv
786 # define call_sv perl_call_sv
789 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
790 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
793 #ifndef PERL_SCAN_SILENT_ILLDIGIT
794 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
797 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
798 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
801 #ifndef PERL_SCAN_DISALLOW_PREFIX
802 # define PERL_SCAN_DISALLOW_PREFIX 0x02
805 #if (PERL_VERSION >= 6)
808 #define I32_CAST (I32*)
812 static UV _grok_hex (char *string, STRLEN *len, I32 *flags, NV *result) {
813 NV r = scan_hex(string, *len, I32_CAST len);
815 *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
816 if (result) *result = r;
822 # define grok_hex(string, len, flags, result) \
823 _grok_hex((string), (len), (flags), (result))
827 static UV _grok_oct (char *string, STRLEN *len, I32 *flags, NV *result) {
828 NV r = scan_oct(string, *len, I32_CAST len);
830 *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
831 if (result) *result = r;
837 # define grok_oct(string, len, flags, result) \
838 _grok_oct((string), (len), (flags), (result))
842 static UV _grok_bin (char *string, STRLEN *len, I32 *flags, NV *result) {
843 NV r = scan_bin(string, *len, I32_CAST len);
845 *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
846 if (result) *result = r;
852 # define grok_bin(string, len, flags, result) \
853 _grok_bin((string), (len), (flags), (result))
858 (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
861 #ifndef IN_LOCALE_RUNTIME
862 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
865 #ifndef IN_LOCALE_COMPILETIME
866 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
870 #ifndef IS_NUMBER_IN_UV
871 # define IS_NUMBER_IN_UV 0x01
872 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
873 # define IS_NUMBER_NOT_INT 0x04
874 # define IS_NUMBER_NEG 0x08
875 # define IS_NUMBER_INFINITY 0x10
876 # define IS_NUMBER_NAN 0x20
879 #ifndef grok_numeric_radix
880 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(aTHX_ sp, send)
882 #define grok_numeric_radix Perl_grok_numeric_radix
885 Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
887 #ifdef USE_LOCALE_NUMERIC
888 #if (PERL_VERSION >= 6)
889 if (PL_numeric_radix_sv && IN_LOCALE) {
891 char* radix = SvPV(PL_numeric_radix_sv, len);
892 if (*sp + len <= send && memEQ(*sp, radix, len)) {
898 /* pre5.6.0 perls don't have PL_numeric_radix_sv so the radix
899 * must manually be requested from locale.h */
901 struct lconv *lc = localeconv();
902 char *radix = lc->decimal_point;
903 if (radix && IN_LOCALE) {
904 STRLEN len = strlen(radix);
905 if (*sp + len <= send && memEQ(*sp, radix, len)) {
910 #endif /* PERL_VERSION */
911 #endif /* USE_LOCALE_NUMERIC */
912 /* always try "." if numeric radix didn't match because
913 * we may have data from different locales mixed */
914 if (*sp < send && **sp == '.') {
920 #endif /* grok_numeric_radix */
924 #define grok_number Perl_grok_number
927 Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
930 const char *send = pv + len;
931 const UV max_div_10 = UV_MAX / 10;
932 const char max_mod_10 = UV_MAX % 10;
937 while (s < send && isSPACE(*s))
941 } else if (*s == '-') {
943 numtype = IS_NUMBER_NEG;
951 /* next must be digit or the radix separator or beginning of infinity */
953 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
956 /* This construction seems to be more optimiser friendly.
957 (without it gcc does the isDIGIT test and the *s - '0' separately)
958 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
959 In theory the optimiser could deduce how far to unroll the loop
960 before checking for overflow. */
962 int digit = *s - '0';
963 if (digit >= 0 && digit <= 9) {
964 value = value * 10 + digit;
967 if (digit >= 0 && digit <= 9) {
968 value = value * 10 + digit;
971 if (digit >= 0 && digit <= 9) {
972 value = value * 10 + digit;
975 if (digit >= 0 && digit <= 9) {
976 value = value * 10 + digit;
979 if (digit >= 0 && digit <= 9) {
980 value = value * 10 + digit;
983 if (digit >= 0 && digit <= 9) {
984 value = value * 10 + digit;
987 if (digit >= 0 && digit <= 9) {
988 value = value * 10 + digit;
991 if (digit >= 0 && digit <= 9) {
992 value = value * 10 + digit;
994 /* Now got 9 digits, so need to check
995 each time for overflow. */
997 while (digit >= 0 && digit <= 9
998 && (value < max_div_10
999 || (value == max_div_10
1000 && digit <= max_mod_10))) {
1001 value = value * 10 + digit;
1007 if (digit >= 0 && digit <= 9
1009 /* value overflowed.
1010 skip the remaining digits, don't
1011 worry about setting *valuep. */
1014 } while (s < send && isDIGIT(*s));
1016 IS_NUMBER_GREATER_THAN_UV_MAX;
1036 numtype |= IS_NUMBER_IN_UV;
1041 if (GROK_NUMERIC_RADIX(&s, send)) {
1042 numtype |= IS_NUMBER_NOT_INT;
1043 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
1047 else if (GROK_NUMERIC_RADIX(&s, send)) {
1048 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
1049 /* no digits before the radix means we need digits after it */
1050 if (s < send && isDIGIT(*s)) {
1053 } while (s < send && isDIGIT(*s));
1055 /* integer approximation is valid - it's 0. */
1061 } else if (*s == 'I' || *s == 'i') {
1062 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
1063 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
1064 s++; if (s < send && (*s == 'I' || *s == 'i')) {
1065 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
1066 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
1067 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
1068 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
1072 } else if (*s == 'N' || *s == 'n') {
1073 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
1074 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
1075 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
1082 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
1083 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
1084 } else if (sawnan) {
1085 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
1086 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
1087 } else if (s < send) {
1088 /* we can have an optional exponent part */
1089 if (*s == 'e' || *s == 'E') {
1090 /* The only flag we keep is sign. Blow away any "it's UV" */
1091 numtype &= IS_NUMBER_NEG;
1092 numtype |= IS_NUMBER_NOT_INT;
1094 if (s < send && (*s == '-' || *s == '+'))
1096 if (s < send && isDIGIT(*s)) {
1099 } while (s < send && isDIGIT(*s));
1105 while (s < send && isSPACE(*s))
1109 if (len == 10 && memEQ(pv, "0 but true", 10)) {
1112 return IS_NUMBER_IN_UV;
1116 #endif /* grok_number */
1117 #endif /* _P_P_PORTABILITY_H_ */
1119 /* End of File ppport.h */