home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _a54cfbaf7429e653012461d3b953b423 < prev    next >
Text File  |  2004-06-01  |  35KB  |  1,295 lines
  1. package Devel::PPPort;
  2.  
  3. =head1 NAME
  4.  
  5. Devel::PPPort - Perl/Pollution/Portability
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.     Devel::PPPort::WriteFile() ; # defaults to ./ppport.h
  10.     Devel::PPPort::WriteFile('someheader.h') ;
  11.  
  12. =head1 DESCRIPTION
  13.  
  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.
  20.  
  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
  23. additional work.
  24.  
  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.
  31.  
  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.
  37.  
  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.
  42.  
  43. This module is used by h2xs to write the file F<ppport.h>. 
  44.  
  45. =head2 WriteFile
  46.  
  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>.
  50.  
  51. The function returns TRUE if the file was written successfully. Otherwise
  52. it returns FALSE.
  53.  
  54. =head1 ppport.h
  55.  
  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):
  59.  
  60.     aMY_CXT
  61.     aMY_CXT_
  62.     _aMY_CXT
  63.     aTHX
  64.     aTHX_
  65.     AvFILLp
  66.     boolSV(b)
  67.     call_argv
  68.     call_method
  69.     call_pv
  70.     call_sv
  71.     dAX
  72.     DEFSV
  73.     dITEMS
  74.     dMY_CXT    
  75.     dMY_CXT_SV
  76.     dNOOP
  77.     dTHR
  78.     dTHX
  79.     dTHXa
  80.     dTHXoa
  81.     ERRSV
  82.     get_av
  83.     get_cv
  84.     get_hv
  85.     get_sv
  86.     grok_hex
  87.     grok_oct
  88.     grok_bin
  89.     grok_number
  90.     grok_numeric_radix
  91.     gv_stashpvn(str,len,flags)
  92.     INT2PTR(type,int)
  93.     IVdf
  94.     MY_CXT
  95.     MY_CXT_INIT
  96.     newCONSTSUB(stash,name,sv)
  97.     newRV_inc(sv)
  98.     newRV_noinc(sv)
  99.     newSVpvn(data,len)
  100.     NOOP
  101.     NV 
  102.     NVef
  103.     NVff
  104.     NVgf
  105.     PERL_REVISION
  106.     PERL_SUBVERSION
  107.     PERL_UNUSED_DECL
  108.     PERL_VERSION
  109.     PL_compiling
  110.     PL_copline
  111.     PL_curcop
  112.     PL_curstash
  113.     PL_defgv
  114.     PL_dirty
  115.     PL_hints
  116.     PL_na
  117.     PL_perldb
  118.     PL_rsfp_filters
  119.     PL_rsfpv
  120.     PL_stdingv
  121.     PL_Sv
  122.     PL_sv_no
  123.     PL_sv_undef
  124.     PL_sv_yes
  125.     pMY_CXT
  126.     pMY_CXT_
  127.     _pMY_CXT
  128.     pTHX
  129.     pTHX_
  130.     PTR2IV(ptr)
  131.     PTR2NV(ptr)
  132.     PTR2ul(ptr)
  133.     PTR2UV(ptr)
  134.     SAVE_DEFSV
  135.     START_MY_CXT
  136.     SvPVbyte(sv,lp) [*]
  137.     UVof
  138.     UVSIZE
  139.     UVuf
  140.     UVxf
  141.     UVXf
  142.  
  143. =head1 AUTHOR
  144.  
  145. Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
  146.  
  147. Version 2.x was ported to the Perl core by Paul Marquess.
  148.  
  149. =head1 SEE ALSO
  150.  
  151. See L<h2xs>.
  152.  
  153. =cut
  154.  
  155.  
  156. package Devel::PPPort;
  157.  
  158. require Exporter;
  159. require DynaLoader;
  160. #use warnings;
  161. use strict;
  162. use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK $data );
  163.  
  164. $VERSION = "2.011";
  165.  
  166. @ISA = qw(Exporter DynaLoader);
  167. @EXPORT =  qw();
  168. # Other items we are prepared to export if requested
  169. @EXPORT_OK = qw( );
  170.  
  171. bootstrap Devel::PPPort;
  172.  
  173. package Devel::PPPort;
  174.  
  175. {
  176.     local $/ = undef;
  177.     $data = <DATA> ;
  178.     my $now = localtime;
  179.     my $pkg = __PACKAGE__;
  180.     $data =~ s/__VERSION__/$VERSION/g;
  181.     $data =~ s/__DATE__/$now/g;
  182.     $data =~ s/__PKG__/$pkg/g;
  183. }
  184.  
  185. sub WriteFile
  186. {
  187.     my $file = shift || 'ppport.h' ;
  188.  
  189.     open F, ">$file" || return undef ;
  190.     print F $data ;
  191.     close F;
  192.  
  193.     return 1 ;
  194. }
  195.  
  196. 1;
  197.  
  198. __DATA__;
  199.  
  200. /* ppport.h -- Perl/Pollution/Portability Version __VERSION__ 
  201.  *
  202.  * Automatically Created by __PKG__ on __DATE__ 
  203.  *
  204.  * Do NOT edit this file directly! -- Edit PPPort.pm instead.
  205.  *
  206.  * Version 2.x, Copyright (C) 2001, Paul Marquess.
  207.  * Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
  208.  * This code may be used and distributed under the same license as any
  209.  * version of Perl.
  210.  * 
  211.  * This version of ppport.h is designed to support operation with Perl
  212.  * installations back to 5.004, and has been tested up to 5.8.1.
  213.  *
  214.  * If this version of ppport.h is failing during the compilation of this
  215.  * module, please check if a newer version of Devel::PPPort is available
  216.  * on CPAN before sending a bug report.
  217.  *
  218.  * If you are using the latest version of Devel::PPPort and it is failing
  219.  * during compilation of this module, please send a report to perlbug@perl.com
  220.  *
  221.  * Include all following information:
  222.  *
  223.  *  1. The complete output from running "perl -V"
  224.  *
  225.  *  2. This file.
  226.  *
  227.  *  3. The name & version of the module you were trying to build.
  228.  *
  229.  *  4. A full log of the build that failed.
  230.  *
  231.  *  5. Any other information that you think could be relevant.
  232.  *
  233.  *
  234.  * For the latest version of this code, please retreive the Devel::PPPort
  235.  * module from CPAN.
  236.  * 
  237.  */
  238.  
  239. /*
  240.  * In order for a Perl extension module to be as portable as possible
  241.  * across differing versions of Perl itself, certain steps need to be taken.
  242.  * Including this header is the first major one, then using dTHR is all the
  243.  * appropriate places and using a PL_ prefix to refer to global Perl
  244.  * variables is the second.
  245.  *
  246.  */
  247.  
  248.  
  249. /* If you use one of a few functions that were not present in earlier
  250.  * versions of Perl, please add a define before the inclusion of ppport.h
  251.  * for a static include, or use the GLOBAL request in a single module to
  252.  * produce a global definition that can be referenced from the other
  253.  * modules.
  254.  * 
  255.  * Function:            Static define:           Extern define:
  256.  * newCONSTSUB()        NEED_newCONSTSUB         NEED_newCONSTSUB_GLOBAL
  257.  *
  258.  */
  259.  
  260.  
  261. /* To verify whether ppport.h is needed for your module, and whether any
  262.  * special defines should be used, ppport.h can be run through Perl to check
  263.  * your source code. Simply say:
  264.  * 
  265.  *     perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
  266.  * 
  267.  * The result will be a list of patches suggesting changes that should at
  268.  * least be acceptable, if not necessarily the most efficient solution, or a
  269.  * fix for all possible problems. It won't catch where dTHR is needed, and
  270.  * doesn't attempt to account for global macro or function definitions,
  271.  * nested includes, typemaps, etc.
  272.  * 
  273.  * In order to test for the need of dTHR, please try your module under a
  274.  * recent version of Perl that has threading compiled-in.
  275.  *
  276.  */ 
  277.  
  278.  
  279. /*
  280. #!/usr/bin/perl
  281. @ARGV = ("*.xs") if !@ARGV;
  282. %badmacros = %funcs = %macros = (); $replace = 0;
  283. foreach (<DATA>) {
  284.     $funcs{$1} = 1 if /Provide:\s+(\S+)/;
  285.     $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
  286.     $replace = $1 if /Replace:\s+(\d+)/;
  287.     $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
  288.     $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
  289. }
  290. foreach $filename (map(glob($_),@ARGV)) {
  291.     unless (open(IN, "<$filename")) {
  292.         warn "Unable to read from $file: $!\n";
  293.         next;
  294.     }
  295.     print "Scanning $filename...\n";
  296.     $c = ""; while (<IN>) { $c .= $_; } close(IN);
  297.     $need_include = 0; %add_func = (); $changes = 0;
  298.     $has_include = ($c =~ /#.*include.*ppport/m);
  299.  
  300.     foreach $func (keys %funcs) {
  301.         if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
  302.             if ($c !~ /\b$func\b/m) {
  303.                 print "If $func isn't needed, you don't need to request it.\n" if
  304.                 $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
  305.             } else {
  306.                 print "Uses $func\n";
  307.                 $need_include = 1;
  308.             }
  309.         } else {
  310.             if ($c =~ /\b$func\b/m) {
  311.                 $add_func{$func} =1 ;
  312.                 print "Uses $func\n";
  313.                 $need_include = 1;
  314.             }
  315.         }
  316.     }
  317.  
  318.     if (not $need_include) {
  319.         foreach $macro (keys %macros) {
  320.             if ($c =~ /\b$macro\b/m) {
  321.                 print "Uses $macro\n";
  322.                 $need_include = 1;
  323.             }
  324.         }
  325.     }
  326.  
  327.     foreach $badmacro (keys %badmacros) {
  328.         if ($c =~ /\b$badmacro\b/m) {
  329.             $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
  330.             print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
  331.             $need_include = 1;
  332.         }
  333.     }
  334.     
  335.     if (scalar(keys %add_func) or $need_include != $has_include) {
  336.         if (!$has_include) {
  337.             $inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
  338.                    "#include \"ppport.h\"\n";
  339.             $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
  340.         } elsif (keys %add_func) {
  341.             $inc = join('',map("#define NEED_$_\n", sort keys %add_func));
  342.             $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
  343.         }
  344.         if (!$need_include) {
  345.             print "Doesn't seem to need ppport.h.\n";
  346.             $c =~ s/^.*#.*include.*ppport.*\n//m;
  347.         }
  348.         $changes++;
  349.     }
  350.     
  351.     if ($changes) {
  352.         open(OUT,">/tmp/ppport.h.$$");
  353.         print OUT $c;
  354.         close(OUT);
  355.         open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
  356.         while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
  357.         close(DIFF);
  358.         unlink("/tmp/ppport.h.$$");
  359.     } else {
  360.         print "Looks OK\n";
  361.     }
  362. }
  363. __DATA__
  364. */
  365.  
  366. #ifndef _P_P_PORTABILITY_H_
  367. #define _P_P_PORTABILITY_H_
  368.  
  369. #ifndef PERL_REVISION
  370. #   ifndef __PATCHLEVEL_H_INCLUDED__
  371. #       define PERL_PATCHLEVEL_H_IMPLICIT
  372. #       include <patchlevel.h>
  373. #   endif
  374. #   if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
  375. #       include <could_not_find_Perl_patchlevel.h>
  376. #   endif
  377. #   ifndef PERL_REVISION
  378. #    define PERL_REVISION    (5)
  379.         /* Replace: 1 */
  380. #       define PERL_VERSION    PATCHLEVEL
  381. #       define PERL_SUBVERSION    SUBVERSION
  382.         /* Replace PERL_PATCHLEVEL with PERL_VERSION */
  383.         /* Replace: 0 */
  384. #   endif
  385. #endif
  386.  
  387. #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
  388.  
  389. /* It is very unlikely that anyone will try to use this with Perl 6 
  390.    (or greater), but who knows.
  391.  */
  392. #if PERL_REVISION != 5
  393. #    error ppport.h only works with Perl version 5
  394. #endif /* PERL_REVISION != 5 */
  395.  
  396. #ifndef ERRSV
  397. #    define ERRSV perl_get_sv("@",FALSE)
  398. #endif
  399.  
  400. #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
  401. /* Replace: 1 */
  402. #    define PL_Sv        Sv
  403. #    define PL_compiling    compiling
  404. #    define PL_copline    copline
  405. #    define PL_curcop    curcop
  406. #    define PL_curstash    curstash
  407. #    define PL_defgv        defgv
  408. #    define PL_dirty        dirty
  409. #    define PL_dowarn    dowarn
  410. #    define PL_hints        hints
  411. #    define PL_na        na
  412. #    define PL_perldb    perldb
  413. #    define PL_rsfp_filters    rsfp_filters
  414. #    define PL_rsfpv        rsfp
  415. #    define PL_stdingv    stdingv
  416. #    define PL_sv_no        sv_no
  417. #    define PL_sv_undef    sv_undef
  418. #    define PL_sv_yes    sv_yes
  419. /* Replace: 0 */
  420. #endif
  421.  
  422. #ifdef HASATTRIBUTE
  423. #  if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
  424. #    define PERL_UNUSED_DECL
  425. #  else
  426. #    define PERL_UNUSED_DECL __attribute__((unused))
  427. #  endif
  428. #else
  429. #  define PERL_UNUSED_DECL
  430. #endif
  431.  
  432. #ifndef dNOOP
  433. #  define NOOP (void)0
  434. #  define dNOOP extern int Perl___notused PERL_UNUSED_DECL
  435. #endif
  436.  
  437. #ifndef dTHR
  438. #  define dTHR          dNOOP
  439. #endif
  440.  
  441. #ifndef dTHX
  442. #  define dTHX          dNOOP
  443. #  define dTHXa(x)      dNOOP
  444. #  define dTHXoa(x)     dNOOP
  445. #endif
  446.  
  447. #ifndef pTHX
  448. #    define pTHX    void
  449. #    define pTHX_
  450. #    define aTHX
  451. #    define aTHX_
  452. #endif         
  453.  
  454. #ifndef dAX
  455. #   define dAX I32 ax = MARK - PL_stack_base + 1
  456. #endif
  457. #ifndef dITEMS
  458. #   define dITEMS I32 items = SP - MARK
  459. #endif
  460.  
  461. /* IV could also be a quad (say, a long long), but Perls
  462.  * capable of those should have IVSIZE already. */
  463. #if !defined(IVSIZE) && defined(LONGSIZE)
  464. #   define IVSIZE LONGSIZE
  465. #endif
  466. #ifndef IVSIZE
  467. #   define IVSIZE 4 /* A bold guess, but the best we can make. */
  468. #endif
  469.  
  470. #ifndef UVSIZE
  471. #   define UVSIZE IVSIZE
  472. #endif
  473.  
  474. #ifndef NVTYPE
  475. #   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
  476. #       define NVTYPE long double
  477. #   else
  478. #       define NVTYPE double
  479. #   endif
  480. typedef NVTYPE NV;
  481. #endif
  482.  
  483. #ifndef INT2PTR
  484.  
  485. #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
  486. #  define PTRV                  UV
  487. #  define INT2PTR(any,d)        (any)(d)
  488. #else
  489. #  if PTRSIZE == LONGSIZE
  490. #    define PTRV                unsigned long
  491. #  else
  492. #    define PTRV                unsigned
  493. #  endif
  494. #  define INT2PTR(any,d)        (any)(PTRV)(d)
  495. #endif
  496. #define NUM2PTR(any,d)  (any)(PTRV)(d)
  497. #define PTR2IV(p)       INT2PTR(IV,p)
  498. #define PTR2UV(p)       INT2PTR(UV,p)
  499. #define PTR2NV(p)       NUM2PTR(NV,p)
  500. #if PTRSIZE == LONGSIZE
  501. #  define PTR2ul(p)     (unsigned long)(p)
  502. #else
  503. #  define PTR2ul(p)     INT2PTR(unsigned long,p)        
  504. #endif
  505.  
  506. #endif /* !INT2PTR */
  507.  
  508. #ifndef boolSV
  509. #    define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
  510. #endif
  511.  
  512. #ifndef gv_stashpvn
  513. #    define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
  514. #endif
  515.  
  516. #ifndef newSVpvn
  517. #    define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
  518. #endif
  519.  
  520. #ifndef newRV_inc
  521. /* Replace: 1 */
  522. #    define newRV_inc(sv) newRV(sv)
  523. /* Replace: 0 */
  524. #endif
  525.  
  526. /* DEFSV appears first in 5.004_56 */
  527. #ifndef DEFSV
  528. #  define DEFSV    GvSV(PL_defgv)
  529. #endif
  530.  
  531. #ifndef SAVE_DEFSV
  532. #    define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
  533. #endif
  534.  
  535. #ifndef newRV_noinc
  536. #  ifdef __GNUC__
  537. #    define newRV_noinc(sv)               \
  538.       ({                                  \
  539.           SV *nsv = (SV*)newRV(sv);       \
  540.           SvREFCNT_dec(sv);               \
  541.           nsv;                            \
  542.       })
  543. #  else
  544. #    if defined(USE_THREADS)
  545. static SV * newRV_noinc (SV * sv)
  546. {
  547.           SV *nsv = (SV*)newRV(sv);       
  548.           SvREFCNT_dec(sv);               
  549.           return nsv;                     
  550. }
  551. #    else
  552. #      define newRV_noinc(sv)    \
  553.         (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
  554. #    endif
  555. #  endif
  556. #endif
  557.  
  558. /* Provide: newCONSTSUB */
  559.  
  560. /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
  561. #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
  562.  
  563. #if defined(NEED_newCONSTSUB)
  564. static
  565. #else
  566. extern void newCONSTSUB(HV * stash, char * name, SV *sv);
  567. #endif
  568.  
  569. #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
  570. void
  571. newCONSTSUB(stash,name,sv)
  572. HV *stash;
  573. char *name;
  574. SV *sv;
  575. {
  576.     U32 oldhints = PL_hints;
  577.     HV *old_cop_stash = PL_curcop->cop_stash;
  578.     HV *old_curstash = PL_curstash;
  579.     line_t oldline = PL_curcop->cop_line;
  580.     PL_curcop->cop_line = PL_copline;
  581.  
  582.     PL_hints &= ~HINT_BLOCK_SCOPE;
  583.     if (stash)
  584.         PL_curstash = PL_curcop->cop_stash = stash;
  585.  
  586.     newSUB(
  587.  
  588. #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
  589.      /* before 5.003_22 */
  590.         start_subparse(),
  591. #else
  592. #  if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
  593.      /* 5.003_22 */
  594.              start_subparse(0),
  595. #  else
  596.      /* 5.003_23  onwards */
  597.              start_subparse(FALSE, 0),
  598. #  endif
  599. #endif
  600.  
  601.         newSVOP(OP_CONST, 0, newSVpv(name,0)),
  602.         newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
  603.         newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
  604.     );
  605.  
  606.     PL_hints = oldhints;
  607.     PL_curcop->cop_stash = old_cop_stash;
  608.     PL_curstash = old_curstash;
  609.     PL_curcop->cop_line = oldline;
  610. }
  611. #endif
  612.  
  613. #endif /* newCONSTSUB */
  614.  
  615. #ifndef START_MY_CXT
  616.  
  617. /*
  618.  * Boilerplate macros for initializing and accessing interpreter-local
  619.  * data from C.  All statics in extensions should be reworked to use
  620.  * this, if you want to make the extension thread-safe.  See ext/re/re.xs
  621.  * for an example of the use of these macros.
  622.  *
  623.  * Code that uses these macros is responsible for the following:
  624.  * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
  625.  * 2. Declare a typedef named my_cxt_t that is a structure that contains
  626.  *    all the data that needs to be interpreter-local.
  627.  * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
  628.  * 4. Use the MY_CXT_INIT macro such that it is called exactly once
  629.  *    (typically put in the BOOT: section).
  630.  * 5. Use the members of the my_cxt_t structure everywhere as
  631.  *    MY_CXT.member.
  632.  * 6. Use the dMY_CXT macro (a declaration) in all the functions that
  633.  *    access MY_CXT.
  634.  */
  635.  
  636. #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
  637.     defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
  638.  
  639. /* This must appear in all extensions that define a my_cxt_t structure,
  640.  * right after the definition (i.e. at file scope).  The non-threads
  641.  * case below uses it to declare the data as static. */
  642. #define START_MY_CXT
  643.  
  644. #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
  645. /* Fetches the SV that keeps the per-interpreter data. */
  646. #define dMY_CXT_SV \
  647.     SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
  648. #else /* >= perl5.004_68 */
  649. #define dMY_CXT_SV \
  650.     SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,        \
  651.                   sizeof(MY_CXT_KEY)-1, TRUE)
  652. #endif /* < perl5.004_68 */
  653.  
  654. /* This declaration should be used within all functions that use the
  655.  * interpreter-local data. */
  656. #define dMY_CXT    \
  657.     dMY_CXT_SV;                            \
  658.     my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
  659.  
  660. /* Creates and zeroes the per-interpreter data.
  661.  * (We allocate my_cxtp in a Perl SV so that it will be released when
  662.  * the interpreter goes away.) */
  663. #define MY_CXT_INIT \
  664.     dMY_CXT_SV;                            \
  665.     /* newSV() allocates one more than needed */            \
  666.     my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
  667.     Zero(my_cxtp, 1, my_cxt_t);                    \
  668.     sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
  669.  
  670. /* This macro must be used to access members of the my_cxt_t structure.
  671.  * e.g. MYCXT.some_data */
  672. #define MY_CXT        (*my_cxtp)
  673.  
  674. /* Judicious use of these macros can reduce the number of times dMY_CXT
  675.  * is used.  Use is similar to pTHX, aTHX etc. */
  676. #define pMY_CXT        my_cxt_t *my_cxtp
  677. #define pMY_CXT_    pMY_CXT,
  678. #define _pMY_CXT    ,pMY_CXT
  679. #define aMY_CXT        my_cxtp
  680. #define aMY_CXT_    aMY_CXT,
  681. #define _aMY_CXT    ,aMY_CXT
  682.  
  683. #else /* single interpreter */
  684.  
  685. #define START_MY_CXT    static my_cxt_t my_cxt;
  686. #define dMY_CXT_SV    dNOOP
  687. #define dMY_CXT        dNOOP
  688. #define MY_CXT_INIT    NOOP
  689. #define MY_CXT        my_cxt
  690.  
  691. #define pMY_CXT        void
  692. #define pMY_CXT_
  693. #define _pMY_CXT
  694. #define aMY_CXT
  695. #define aMY_CXT_
  696. #define _aMY_CXT
  697.  
  698. #endif 
  699.  
  700. #endif /* START_MY_CXT */
  701.  
  702. #ifndef IVdf
  703. #  if IVSIZE == LONGSIZE
  704. #       define    IVdf        "ld"
  705. #       define    UVuf        "lu"
  706. #       define    UVof        "lo"
  707. #       define    UVxf        "lx"
  708. #       define    UVXf        "lX"
  709. #   else
  710. #       if IVSIZE == INTSIZE
  711. #           define    IVdf    "d"
  712. #           define    UVuf    "u"
  713. #           define    UVof    "o"
  714. #           define    UVxf    "x"
  715. #           define    UVXf    "X"
  716. #       endif
  717. #   endif
  718. #endif
  719.  
  720. #ifndef NVef
  721. #   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
  722.     defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ 
  723. #       define NVef        PERL_PRIeldbl
  724. #       define NVff        PERL_PRIfldbl
  725. #       define NVgf        PERL_PRIgldbl
  726. #   else
  727. #       define NVef        "e"
  728. #       define NVff        "f"
  729. #       define NVgf        "g"
  730. #   endif
  731. #endif
  732.  
  733. #ifndef AvFILLp            /* Older perls (<=5.003) lack AvFILLp */
  734. #   define AvFILLp AvFILL
  735. #endif
  736.  
  737. #ifdef SvPVbyte
  738. #   if PERL_REVISION == 5 && PERL_VERSION < 7
  739.        /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
  740. #       undef SvPVbyte
  741. #       define SvPVbyte(sv, lp) \
  742.           ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
  743.            ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
  744.        static char *
  745.        my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
  746.        {   
  747.            sv_utf8_downgrade(sv,0);
  748.            return SvPV(sv,*lp);
  749.        }
  750. #   endif
  751. #else
  752. #   define SvPVbyte SvPV
  753. #endif
  754.  
  755. #ifndef SvPV_nolen
  756. #   define SvPV_nolen(sv) \
  757.         ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
  758.          ? SvPVX(sv) : sv_2pv_nolen(sv))
  759.     static char *
  760.     sv_2pv_nolen(pTHX_ register SV *sv)
  761.     {   
  762.         STRLEN n_a;
  763.         return sv_2pv(sv, &n_a);
  764.     }
  765. #endif
  766.  
  767. #ifndef get_cv
  768. #   define get_cv(name,create) perl_get_cv(name,create)
  769. #endif
  770.  
  771. #ifndef get_sv
  772. #   define get_sv(name,create) perl_get_sv(name,create)
  773. #endif
  774.  
  775. #ifndef get_av
  776. #   define get_av(name,create) perl_get_av(name,create)
  777. #endif
  778.  
  779. #ifndef get_hv
  780. #   define get_hv(name,create) perl_get_hv(name,create)
  781. #endif
  782.  
  783. #ifndef call_argv
  784. #   define call_argv perl_call_argv
  785. #endif
  786.  
  787. #ifndef call_method
  788. #   define call_method perl_call_method
  789. #endif
  790.  
  791. #ifndef call_pv
  792. #   define call_pv perl_call_pv
  793. #endif
  794.  
  795. #ifndef call_sv
  796. #   define call_sv perl_call_sv
  797. #endif
  798.  
  799. #ifndef eval_pv
  800. #   define eval_pv perl_eval_pv
  801. #endif
  802.  
  803. #ifndef eval_sv
  804. #   define eval_sv perl_eval_sv
  805. #endif
  806.  
  807. #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
  808. #   define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
  809. #endif
  810.  
  811. #ifndef PERL_SCAN_SILENT_ILLDIGIT
  812. #   define PERL_SCAN_SILENT_ILLDIGIT 0x04
  813. #endif
  814.  
  815. #ifndef PERL_SCAN_ALLOW_UNDERSCORES
  816. #   define PERL_SCAN_ALLOW_UNDERSCORES 0x01
  817. #endif
  818.  
  819. #ifndef PERL_SCAN_DISALLOW_PREFIX
  820. #   define PERL_SCAN_DISALLOW_PREFIX 0x02
  821. #endif
  822.  
  823. #if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
  824. #define I32_CAST
  825. #else
  826. #define I32_CAST (I32*)
  827. #endif
  828.  
  829. #ifndef grok_hex
  830. static UV _grok_hex (char *string, STRLEN *len, I32 *flags, NV *result) {
  831.     NV r = scan_hex(string, *len, I32_CAST len);
  832.     if (r > UV_MAX) {
  833.         *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
  834.         if (result) *result = r;
  835.         return UV_MAX;
  836.     }
  837.     return (UV)r;
  838. }
  839.         
  840. #   define grok_hex(string, len, flags, result)     \
  841.         _grok_hex((string), (len), (flags), (result))
  842. #endif 
  843.  
  844. #ifndef grok_oct
  845. static UV _grok_oct (char *string, STRLEN *len, I32 *flags, NV *result) {
  846.     NV r = scan_oct(string, *len, I32_CAST len);
  847.     if (r > UV_MAX) {
  848.         *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
  849.         if (result) *result = r;
  850.         return UV_MAX;
  851.     }
  852.     return (UV)r;
  853. }
  854.  
  855. #   define grok_oct(string, len, flags, result)     \
  856.         _grok_oct((string), (len), (flags), (result))
  857. #endif
  858.  
  859. #if !defined(grok_bin) && defined(scan_bin)
  860. static UV _grok_bin (char *string, STRLEN *len, I32 *flags, NV *result) {
  861.     NV r = scan_bin(string, *len, I32_CAST len);
  862.     if (r > UV_MAX) {
  863.         *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
  864.         if (result) *result = r;
  865.         return UV_MAX;
  866.     }
  867.     return (UV)r;
  868. }
  869.  
  870. #   define grok_bin(string, len, flags, result)     \
  871.         _grok_bin((string), (len), (flags), (result))
  872. #endif
  873.  
  874. #ifndef IN_LOCALE
  875. #   define IN_LOCALE \
  876.     (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
  877. #endif
  878.  
  879. #ifndef IN_LOCALE_RUNTIME
  880. #   define IN_LOCALE_RUNTIME   (PL_curcop->op_private & HINT_LOCALE)
  881. #endif
  882.  
  883. #ifndef IN_LOCALE_COMPILETIME
  884. #   define IN_LOCALE_COMPILETIME   (PL_hints & HINT_LOCALE)
  885. #endif
  886.  
  887.  
  888. #ifndef IS_NUMBER_IN_UV
  889. #   define IS_NUMBER_IN_UV                    0x01   
  890. #   define IS_NUMBER_GREATER_THAN_UV_MAX    0x02
  891. #   define IS_NUMBER_NOT_INT                0x04
  892. #   define IS_NUMBER_NEG                    0x08
  893. #   define IS_NUMBER_INFINITY                0x10 
  894. #   define IS_NUMBER_NAN                    0x20  
  895. #endif
  896.    
  897. #ifndef grok_numeric_radix
  898. #   define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(aTHX_ sp, send)
  899.  
  900. #define grok_numeric_radix Perl_grok_numeric_radix
  901.     
  902. bool
  903. Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
  904. {
  905. #ifdef USE_LOCALE_NUMERIC
  906. #if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
  907.     if (PL_numeric_radix_sv && IN_LOCALE) { 
  908.         STRLEN len;
  909.         char* radix = SvPV(PL_numeric_radix_sv, len);
  910.         if (*sp + len <= send && memEQ(*sp, radix, len)) {
  911.             *sp += len;
  912.             return TRUE; 
  913.         }
  914.     }
  915. #else
  916.     /* pre5.6.0 perls don't have PL_numeric_radix_sv so the radix
  917.      * must manually be requested from locale.h */
  918. #include <locale.h>
  919.     struct lconv *lc = localeconv();
  920.     char *radix = lc->decimal_point;
  921.     if (radix && IN_LOCALE) { 
  922.         STRLEN len = strlen(radix);
  923.         if (*sp + len <= send && memEQ(*sp, radix, len)) {
  924.             *sp += len;
  925.             return TRUE; 
  926.         }
  927.     }
  928. #endif /* PERL_VERSION */
  929. #endif /* USE_LOCALE_NUMERIC */
  930.     /* always try "." if numeric radix didn't match because
  931.      * we may have data from different locales mixed */
  932.     if (*sp < send && **sp == '.') {
  933.         ++*sp;
  934.         return TRUE;
  935.     }
  936.     return FALSE;
  937. }
  938. #endif /* grok_numeric_radix */
  939.  
  940. #ifndef grok_number
  941.  
  942. #define grok_number Perl_grok_number
  943.  
  944. int
  945. Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
  946. {
  947.   const char *s = pv;
  948.   const char *send = pv + len;
  949.   const UV max_div_10 = UV_MAX / 10;
  950.   const char max_mod_10 = UV_MAX % 10;
  951.   int numtype = 0;
  952.   int sawinf = 0;
  953.   int sawnan = 0;
  954.  
  955.   while (s < send && isSPACE(*s))
  956.     s++;
  957.   if (s == send) {
  958.     return 0;
  959.   } else if (*s == '-') {
  960.     s++;
  961.     numtype = IS_NUMBER_NEG;
  962.   }
  963.   else if (*s == '+')
  964.   s++;
  965.  
  966.   if (s == send)
  967.     return 0;
  968.  
  969.   /* next must be digit or the radix separator or beginning of infinity */
  970.   if (isDIGIT(*s)) {
  971.     /* UVs are at least 32 bits, so the first 9 decimal digits cannot
  972.        overflow.  */
  973.     UV value = *s - '0';
  974.     /* This construction seems to be more optimiser friendly.
  975.        (without it gcc does the isDIGIT test and the *s - '0' separately)
  976.        With it gcc on arm is managing 6 instructions (6 cycles) per digit.
  977.        In theory the optimiser could deduce how far to unroll the loop
  978.        before checking for overflow.  */
  979.     if (++s < send) {
  980.       int digit = *s - '0';
  981.       if (digit >= 0 && digit <= 9) {
  982.         value = value * 10 + digit;
  983.         if (++s < send) {
  984.           digit = *s - '0';
  985.           if (digit >= 0 && digit <= 9) {
  986.             value = value * 10 + digit;
  987.             if (++s < send) {
  988.               digit = *s - '0';
  989.               if (digit >= 0 && digit <= 9) {
  990.                 value = value * 10 + digit;
  991.                 if (++s < send) {
  992.                   digit = *s - '0';
  993.                   if (digit >= 0 && digit <= 9) {
  994.                     value = value * 10 + digit;
  995.                     if (++s < send) {
  996.                       digit = *s - '0';
  997.                       if (digit >= 0 && digit <= 9) {
  998.                         value = value * 10 + digit;
  999.                         if (++s < send) {
  1000.                           digit = *s - '0';
  1001.                           if (digit >= 0 && digit <= 9) {
  1002.                             value = value * 10 + digit;
  1003.                             if (++s < send) {
  1004.                               digit = *s - '0';
  1005.                               if (digit >= 0 && digit <= 9) {
  1006.                                 value = value * 10 + digit;
  1007.                                 if (++s < send) {
  1008.                                   digit = *s - '0';
  1009.                                   if (digit >= 0 && digit <= 9) {
  1010.                                     value = value * 10 + digit;
  1011.                                     if (++s < send) {
  1012.                                       /* Now got 9 digits, so need to check
  1013.                                          each time for overflow.  */
  1014.                                       digit = *s - '0';
  1015.                                       while (digit >= 0 && digit <= 9
  1016.                                              && (value < max_div_10
  1017.                                                  || (value == max_div_10
  1018.                                                      && digit <= max_mod_10))) {
  1019.                                         value = value * 10 + digit;
  1020.                                         if (++s < send)
  1021.                                           digit = *s - '0';
  1022.                                         else
  1023.                                           break;
  1024.                                       }
  1025.                                       if (digit >= 0 && digit <= 9
  1026.                                           && (s < send)) {
  1027.                                         /* value overflowed.
  1028.                                            skip the remaining digits, don't
  1029.                                            worry about setting *valuep.  */
  1030.                                         do {
  1031.                                           s++;
  1032.                                         } while (s < send && isDIGIT(*s));
  1033.                                         numtype |=
  1034.                                           IS_NUMBER_GREATER_THAN_UV_MAX;
  1035.                                         goto skip_value;
  1036.                                       }
  1037.                                     }
  1038.                                   }
  1039.                                 }
  1040.                               }
  1041.                             }
  1042.                           }
  1043.                         }
  1044.                       }
  1045.                     }
  1046.                   }
  1047.                 }
  1048.               }
  1049.             }
  1050.           }
  1051.         }
  1052.       }
  1053.     }
  1054.     numtype |= IS_NUMBER_IN_UV;
  1055.     if (valuep)
  1056.       *valuep = value;
  1057.  
  1058.   skip_value:
  1059.     if (GROK_NUMERIC_RADIX(&s, send)) {
  1060.       numtype |= IS_NUMBER_NOT_INT;
  1061.       while (s < send && isDIGIT(*s))  /* optional digits after the radix */
  1062.         s++;
  1063.     }
  1064.   }
  1065.   else if (GROK_NUMERIC_RADIX(&s, send)) {
  1066.     numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
  1067.     /* no digits before the radix means we need digits after it */
  1068.     if (s < send && isDIGIT(*s)) {
  1069.       do {
  1070.         s++;
  1071.       } while (s < send && isDIGIT(*s));
  1072.       if (valuep) {
  1073.         /* integer approximation is valid - it's 0.  */
  1074.         *valuep = 0;
  1075.       }
  1076.     }
  1077.     else
  1078.       return 0;
  1079.   } else if (*s == 'I' || *s == 'i') {
  1080.     s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
  1081.     s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
  1082.     s++; if (s < send && (*s == 'I' || *s == 'i')) {
  1083.       s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
  1084.       s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
  1085.       s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
  1086.       s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
  1087.       s++;
  1088.     }
  1089.     sawinf = 1;
  1090.   } else if (*s == 'N' || *s == 'n') {
  1091.     /* XXX TODO: There are signaling NaNs and quiet NaNs. */
  1092.     s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
  1093.     s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
  1094.     s++;
  1095.     sawnan = 1;
  1096.   } else
  1097.     return 0;
  1098.  
  1099.   if (sawinf) {
  1100.     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
  1101.     numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
  1102.   } else if (sawnan) {
  1103.     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
  1104.     numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
  1105.   } else if (s < send) {
  1106.     /* we can have an optional exponent part */
  1107.     if (*s == 'e' || *s == 'E') {
  1108.       /* The only flag we keep is sign.  Blow away any "it's UV"  */
  1109.       numtype &= IS_NUMBER_NEG;
  1110.       numtype |= IS_NUMBER_NOT_INT;
  1111.       s++;
  1112.       if (s < send && (*s == '-' || *s == '+'))
  1113.         s++;
  1114.       if (s < send && isDIGIT(*s)) {
  1115.         do {
  1116.           s++;
  1117.         } while (s < send && isDIGIT(*s));
  1118.       }
  1119.       else
  1120.       return 0;
  1121.     }
  1122.   }
  1123.   while (s < send && isSPACE(*s))
  1124.     s++;
  1125.   if (s >= send)
  1126.     return numtype;
  1127.   if (len == 10 && memEQ(pv, "0 but true", 10)) {
  1128.     if (valuep)
  1129.       *valuep = 0;
  1130.     return IS_NUMBER_IN_UV;
  1131.   }
  1132.   return 0;
  1133. }
  1134. #endif /* grok_number */
  1135.  
  1136. #ifndef PERL_MAGIC_sv
  1137. #   define PERL_MAGIC_sv             '\0'
  1138. #endif
  1139.  
  1140. #ifndef PERL_MAGIC_overload
  1141. #   define PERL_MAGIC_overload       'A'
  1142. #endif
  1143.  
  1144. #ifndef PERL_MAGIC_overload_elem
  1145. #   define PERL_MAGIC_overload_elem  'a'
  1146. #endif
  1147.  
  1148. #ifndef PERL_MAGIC_overload_table
  1149. #   define PERL_MAGIC_overload_table 'c'
  1150. #endif
  1151.  
  1152. #ifndef PERL_MAGIC_bm
  1153. #   define PERL_MAGIC_bm             'B'
  1154. #endif
  1155.  
  1156. #ifndef PERL_MAGIC_regdata
  1157. #   define PERL_MAGIC_regdata        'D'
  1158. #endif
  1159.  
  1160. #ifndef PERL_MAGIC_regdatum
  1161. #   define PERL_MAGIC_regdatum       'd'
  1162. #endif
  1163.  
  1164. #ifndef PERL_MAGIC_env
  1165. #   define PERL_MAGIC_env            'E'
  1166. #endif
  1167.  
  1168. #ifndef PERL_MAGIC_envelem
  1169. #   define PERL_MAGIC_envelem        'e'
  1170. #endif
  1171.  
  1172. #ifndef PERL_MAGIC_fm
  1173. #   define PERL_MAGIC_fm             'f'
  1174. #endif
  1175.  
  1176. #ifndef PERL_MAGIC_regex_global
  1177. #   define PERL_MAGIC_regex_global   'g'
  1178. #endif
  1179.  
  1180. #ifndef PERL_MAGIC_isa
  1181. #   define PERL_MAGIC_isa            'I'
  1182. #endif
  1183.  
  1184. #ifndef PERL_MAGIC_isaelem
  1185. #   define PERL_MAGIC_isaelem        'i'
  1186. #endif
  1187.  
  1188. #ifndef PERL_MAGIC_nkeys
  1189. #   define PERL_MAGIC_nkeys          'k'
  1190. #endif
  1191.  
  1192. #ifndef PERL_MAGIC_dbfile
  1193. #   define PERL_MAGIC_dbfile         'L'
  1194. #endif
  1195.  
  1196. #ifndef PERL_MAGIC_dbline
  1197. #   define PERL_MAGIC_dbline         'l'
  1198. #endif
  1199.  
  1200. #ifndef PERL_MAGIC_mutex
  1201. #   define PERL_MAGIC_mutex          'm'
  1202. #endif
  1203.  
  1204. #ifndef PERL_MAGIC_shared
  1205. #   define PERL_MAGIC_shared         'N'
  1206. #endif
  1207.  
  1208. #ifndef PERL_MAGIC_shared_scalar
  1209. #   define PERL_MAGIC_shared_scalar  'n'
  1210. #endif
  1211.  
  1212. #ifndef PERL_MAGIC_collxfrm
  1213. #   define PERL_MAGIC_collxfrm       'o'
  1214. #endif
  1215.  
  1216. #ifndef PERL_MAGIC_tied
  1217. #   define PERL_MAGIC_tied           'P'
  1218. #endif
  1219.  
  1220. #ifndef PERL_MAGIC_tiedelem
  1221. #   define PERL_MAGIC_tiedelem       'p'
  1222. #endif
  1223.  
  1224. #ifndef PERL_MAGIC_tiedscalar
  1225. #   define PERL_MAGIC_tiedscalar     'q'
  1226. #endif
  1227.  
  1228. #ifndef PERL_MAGIC_qr
  1229. #   define PERL_MAGIC_qr             'r'
  1230. #endif
  1231.  
  1232. #ifndef PERL_MAGIC_sig
  1233. #   define PERL_MAGIC_sig            'S'
  1234. #endif
  1235.  
  1236. #ifndef PERL_MAGIC_sigelem
  1237. #   define PERL_MAGIC_sigelem        's'
  1238. #endif
  1239.  
  1240. #ifndef PERL_MAGIC_taint
  1241. #   define PERL_MAGIC_taint          't'
  1242. #endif
  1243.  
  1244. #ifndef PERL_MAGIC_uvar
  1245. #   define PERL_MAGIC_uvar           'U'
  1246. #endif
  1247.  
  1248. #ifndef PERL_MAGIC_uvar_elem
  1249. #   define PERL_MAGIC_uvar_elem      'u'
  1250. #endif
  1251.  
  1252. #ifndef PERL_MAGIC_vstring
  1253. #   define PERL_MAGIC_vstring        'V'
  1254. #endif
  1255.  
  1256. #ifndef PERL_MAGIC_vec
  1257. #   define PERL_MAGIC_vec            'v'
  1258. #endif
  1259.  
  1260. #ifndef PERL_MAGIC_utf8
  1261. #   define PERL_MAGIC_utf8           'w'
  1262. #endif
  1263.  
  1264. #ifndef PERL_MAGIC_substr
  1265. #   define PERL_MAGIC_substr         'x'
  1266. #endif
  1267.  
  1268. #ifndef PERL_MAGIC_defelem
  1269. #   define PERL_MAGIC_defelem        'y'
  1270. #endif
  1271.  
  1272. #ifndef PERL_MAGIC_glob
  1273. #   define PERL_MAGIC_glob           '*'
  1274. #endif
  1275.  
  1276. #ifndef PERL_MAGIC_arylen
  1277. #   define PERL_MAGIC_arylen         '#'
  1278. #endif
  1279.  
  1280. #ifndef PERL_MAGIC_pos
  1281. #   define PERL_MAGIC_pos            '.'
  1282. #endif
  1283.  
  1284. #ifndef PERL_MAGIC_backref
  1285. #   define PERL_MAGIC_backref        '<'
  1286. #endif
  1287.  
  1288. #ifndef PERL_MAGIC_ext
  1289. #   define PERL_MAGIC_ext            '~'
  1290. #endif
  1291.  
  1292. #endif /* _P_P_PORTABILITY_H_ */
  1293.  
  1294. /* End of File ppport.h */
  1295.