├── package.json
├── src
    ├── perlxsi.c
    ├── embed_perl.h
    ├── perl_bindings.cc
    └── ppport.h
├── README.markdown
└── wscript


/package.json:
--------------------------------------------------------------------------------
1 | {"name" : "perl",
2 |  "description" : "Embeded perl interpreter",
3 |  "version" : "0.0.1",
4 |  "main" : "./perl",
5 |  "scripts" : { "build" : "node-waf configure build" }
6 | }


--------------------------------------------------------------------------------
/src/perlxsi.c:
--------------------------------------------------------------------------------
 1 | #include <EXTERN.h>
 2 | #include <perl.h>
 3 | 
 4 | EXTERN_C void xs_init (pTHX);
 5 | 
 6 | EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
 7 | 
 8 | EXTERN_C void
 9 | xs_init(pTHX)
10 | {
11 | 	dXSUB_SYS;
12 | 
13 | 	/* DynaLoader is a special case */
14 | 	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
15 | }
16 | 


--------------------------------------------------------------------------------
/README.markdown:
--------------------------------------------------------------------------------
 1 | node-perl
 2 | =========
 3 | 
 4 | Embed Perl interpreter for node.js
 5 | 
 6 | ## Install
 7 | 
 8 |     #>git clone git://github.com/hideo55/node-perl.git
 9 |     #>cd node-perl
10 |     #>node-waf configure
11 |     #>node-waf build
12 |     #>node-waf install
13 | 
14 | ## Tutorial
15 | 
16 |     var Perl = require('perl').Perl();
17 |     var perl = new Perl();
18 | 
19 |     perl.Run({
20 | 	    opts : ["-Mfeature=say","-e","say 'Hello world'"]
21 |     }, function(out,err){
22 | 	    console.log(out);
23 |     });
24 | 
25 |     perl.Run({
26 | 	    script : 'example.pl',
27 | 	    args : ['foo', 'bar']
28 |     });
29 | 
30 | ## API
31 | 
32 | ### Run(options,[callback])
33 | 
34 | ## License
35 | 
36 | node-perl is licensed under the MIT license.


--------------------------------------------------------------------------------
/wscript:
--------------------------------------------------------------------------------
 1 | import Utils
 2 | 
 3 | srcdir = '.'
 4 | blddir = 'build'
 5 | VERSION = '0.0.1'
 6 | 
 7 | def set_options(opt): 
 8 |     opt.tool_options('compiler_cxx')
 9 | 
10 | def configure(conf):
11 |     conf.check_tool('compiler_cxx')
12 |     conf.check_tool('node_addon')
13 |     conf.env.append_unique('CXXFLAGS',Utils.cmd_output('perl -MExtUtils::Embed -e ccopts').split())
14 |     conf.env.append_unique('CXXFLAGS',['-Duseithreads'])
15 |     conf.env.append_unique('LINKFLAGS',Utils.cmd_output('perl -MExtUtils::Embed -e ldopts').split())
16 |     #Utils.exec_command('perl -MExtUtils::Embed -e xsinit -- -o src/perlxsi.c')
17 | 
18 | def build(bld):
19 |     obj = bld.new_task_gen('cxx', 'shlib', 'node_addon')
20 |     obj.target = 'perl'
21 |     obj.source = './src/perlxsi.c ./src/perl_bindings.cc'
22 | 
23 | 


--------------------------------------------------------------------------------
/src/embed_perl.h:
--------------------------------------------------------------------------------
  1 | #ifndef EMBED_PERL_H_
  2 | #define EMBED_PERL_H_
  3 | 
  4 | #include <string>
  5 | extern "C" {
  6 | #define PERLIO_NOT_STDIO 0
  7 | #define USE_PERLIO
  8 | #include <EXTERN.h>
  9 | #include <perl.h>
 10 | #include "ppport.h"
 11 | }
 12 | 
 13 | #ifdef New
 14 | #undef New
 15 | #endif
 16 | 
 17 | EXTERN_C void xs_init(pTHX);
 18 | 
 19 | class EmbedPerl {
 20 | public:
 21 | 
 22 | 	EmbedPerl() {
 23 | 		perl = perl_alloc();
 24 | 		perl_construct(perl);
 25 | 	}
 26 | 
 27 | 	~EmbedPerl() {
 28 | 		PL_perl_destruct_level = 2;
 29 | 		perl_destruct(perl);
 30 | 		perl_free(perl);
 31 | 	}
 32 | 
 33 | 	int run(int argc, const std::string *argv, std::string& out,
 34 | 			std::string& err) {
 35 | 
 36 | 		int exitstatus = 0;
 37 | 
 38 | 		PERL_SYS_INIT3(&argc, (char ***) &argv, (char ***) NULL);
 39 | 
 40 | 		PL_perl_destruct_level = 2;
 41 | 		exitstatus = perl_parse(perl, xs_init, argc, (char **) argv,
 42 | 				(char **) NULL);
 43 | 		if (exitstatus != 0) {
 44 | 			return exitstatus;
 45 | 		}
 46 | 
 47 | 		ENTER;SAVETMPS;
 48 | 
 49 | 		SV *outsv = sv_newmortal();
 50 | 		SV *errsv = sv_newmortal();
 51 | 
 52 | 		this->override_stdhandle(aTHX_ outsv, "STDOUT");
 53 | 		this->override_stdhandle(aTHX_ errsv, "STDERR");
 54 | 
 55 | 		perl_run(perl);
 56 | 
 57 | 		this->restore_stdhandle(aTHX_ "STDOUT");
 58 | 		this->restore_stdhandle(aTHX_ "STDERR");
 59 | 
 60 | 		STRLEN outlen = SvCUR(outsv);
 61 | 		char *tmpout = SvPV_nolen(outsv);
 62 | 		out = std::string(tmpout, outlen);
 63 | 
 64 | 		STRLEN errlen = SvCUR(errsv);
 65 | 		char * tmperr = SvPV_nolen(errsv);
 66 | 		err = std::string(tmperr, errlen);
 67 | 
 68 | 		FREETMPS;LEAVE;
 69 | 
 70 | 		PERL_SYS_TERM();
 71 | 
 72 | 		return 0;
 73 | 	}
 74 | 
 75 | private:
 76 | 
 77 | 	PerlInterpreter *perl;
 78 | 
 79 | void override_stdhandle (pTHX_ SV *sv,const char *name ) {
 80 | 	int status;
 81 | 	GV *handle = gv_fetchpv(name,TRUE,SVt_PVIO);
 82 | 	SV *svref = newRV_inc(sv);
 83 | 
 84 | 	save_gp(handle, 1);
 85 | 
 86 | 	status = Perl_do_open9(aTHX_ handle, ">:scalar", 8 , FALSE, O_WRONLY, 0, Nullfp, svref, 1);
 87 | 	if(status == 0) {
 88 | 		Perl_croak(aTHX_ "Failed to open %s: %" SVf,name, get_sv("!",TRUE));
 89 | 	}
 90 | }
 91 | 
 92 | void restore_stdhandle (pTHX_ const char *name) {
 93 | 	int status;
 94 | 	GV *handle = gv_fetchpv(name,FALSE,SVt_PVIO);
 95 | 
 96 | 	if( GvIOn(handle) && IoOFP(GvIOn(handle)) && (PerlIO_flush(IoOFP(GvIOn(handle))) == -1 ) ) {
 97 | 		Perl_croak(aTHX_ "Failed to flush %s: " SVf,name,get_sv("!",TRUE) );
 98 | 	}
 99 | }
100 | 
101 | };
102 | 
103 | #endif /* EMBED_PERL_H_ */
104 | 


--------------------------------------------------------------------------------
/src/perl_bindings.cc:
--------------------------------------------------------------------------------
  1 | #define BUILDING_NODE_EXTENSION
  2 | 
  3 | #include <node.h>
  4 | #include <string>
  5 | #include <vector>
  6 | #include "embed_perl.h"
  7 | 
  8 | #define INTERPRETER_NAME "node-perl"
  9 | 
 10 | using namespace v8;
 11 | using namespace node;
 12 | 
 13 | class NodePerl: ObjectWrap {
 14 | public:
 15 | 
 16 |     NodePerl() {
 17 |         p = new EmbedPerl();
 18 |     }
 19 | 
 20 |     static Handle<Value> New(const Arguments& args) {
 21 |         HandleScope scope;
 22 | 
 23 |         if (!args.IsConstructCall())
 24 |             return args.Callee()->NewInstance();
 25 |         try {
 26 |             (new NodePerl())->Wrap(args.Holder());
 27 |         } catch (const char *msg) {
 28 |             return ThrowException(Exception::Error(String::New(msg)));
 29 |         }
 30 |         return scope.Close(args.Holder());
 31 |     }
 32 | 
 33 |     static Handle<Value> Run(const Arguments& args) {
 34 |         HandleScope scope;
 35 |         if (!args[0]->IsObject()) {
 36 |             return ThrowException(Exception::Error(String::New("Arguments must be JavaScript Array")));
 37 |         }
 38 | 
 39 |         std::vector<std::string> args_v;
 40 |         args_v.push_back(INTERPRETER_NAME);
 41 | 
 42 |         //process parameters
 43 |         Local<Object> arg = args[0]->ToObject();
 44 | 
 45 |         if (arg->Has(String::New("opts"))) {
 46 |             if (arg->Get(String::New("opts"))->IsArray()) {
 47 |                 Local<Object> opts = (arg->Get(String::New("opts")))->ToObject();
 48 |                 int len = (opts->GetPropertyNames())->Length();
 49 |                 for (int i = 0; i < len; i++) {
 50 |                     args_v.push_back(*String::Utf8Value(opts->Get(Integer::New(i))->ToString()));
 51 |                 }
 52 |             }
 53 |         }
 54 | 
 55 |         if (arg->Has(String::New("script"))) {
 56 |             if (arg->Get(String::New("script"))->IsString()) {
 57 |                 args_v.push_back(*String::Utf8Value(arg->Get(String::New("script"))->ToString()));
 58 |             }
 59 |         }
 60 | 
 61 |         if (arg->Has(String::New("args"))) {
 62 |             if (arg->Get(String::New("args"))->IsArray()) {
 63 |                 Local<Object> argv = arg->Get(String::New("args"))->ToObject();
 64 |                 int len = (argv->GetPropertyNames())->Length();
 65 |                 for (int i = 0; i < len; i++) {
 66 |                     args_v.push_back(*String::Utf8Value(argv->Get(Integer::New(i))->ToString()));
 67 |                 }
 68 |             }
 69 |         }
 70 | 
 71 |         std::string *perl_args = new std::string[args_v.size()];
 72 |         for (int i = 0; i < args_v.size(); i++) {
 73 |             perl_args[i] = args_v[i];
 74 |         }
 75 | 
 76 |         Persistent<Function> callback = Persistent<Function>::New(Local<Function>::Cast(args[1]));
 77 | 
 78 |         std::string out, err;
 79 |         Unwrap<NodePerl> (args.This())->Run(args_v.size(), perl_args, out, err);
 80 | 
 81 |         Handle<Value> argv[2];
 82 |         argv[0] = String::New(out.c_str(), out.size());
 83 |         argv[1] = String::New("");
 84 | 
 85 |         callback->Call(Context::GetCalling()->Global(), 2, argv);
 86 | 
 87 |         return scope.Close(Undefined());
 88 |     }
 89 | 
 90 | private:
 91 |     EmbedPerl *p;
 92 | 
 93 |     int Run(int argc, std::string *argv, std::string& out, std::string& err) {
 94 |         p->run(argc, argv, out, err);
 95 |         return 0;
 96 |     }
 97 | };
 98 | 
 99 | extern "C" void init(Handle<Object> target) {
100 |     HandleScope scope;
101 |     Local<FunctionTemplate> t = FunctionTemplate::New(NodePerl::New);
102 |     NODE_SET_PROTOTYPE_METHOD(t, "Run", NodePerl::Run);
103 |     t->InstanceTemplate()->SetInternalFieldCount(1);
104 |     target->Set(String::New("Perl"), t->GetFunction());
105 | }
106 | 
107 | 


--------------------------------------------------------------------------------
/src/ppport.h:
--------------------------------------------------------------------------------
   1 | #if 0
   2 | <<'SKIP';
   3 | #endif
   4 | /*
   5 | ----------------------------------------------------------------------
   6 | 
   7 |     ppport.h -- Perl/Pollution/Portability Version 3.20
   8 | 
   9 |     Automatically created by Devel::PPPort running under perl 5.015004.
  10 | 
  11 |     Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
  12 |     includes in parts/inc/ instead.
  13 | 
  14 |     Use 'perldoc ppport.h' to view the documentation below.
  15 | 
  16 | ----------------------------------------------------------------------
  17 | 
  18 | SKIP
  19 | 
  20 | =pod
  21 | 
  22 | =head1 NAME
  23 | 
  24 | ppport.h - Perl/Pollution/Portability version 3.20
  25 | 
  26 | =head1 SYNOPSIS
  27 | 
  28 |   perl ppport.h [options] [source files]
  29 | 
  30 |   Searches current directory for files if no [source files] are given
  31 | 
  32 |   --help                      show short help
  33 | 
  34 |   --version                   show version
  35 | 
  36 |   --patch=file                write one patch file with changes
  37 |   --copy=suffix               write changed copies with suffix
  38 |   --diff=program              use diff program and options
  39 | 
  40 |   --compat-version=version    provide compatibility with Perl version
  41 |   --cplusplus                 accept C++ comments
  42 | 
  43 |   --quiet                     don't output anything except fatal errors
  44 |   --nodiag                    don't show diagnostics
  45 |   --nohints                   don't show hints
  46 |   --nochanges                 don't suggest changes
  47 |   --nofilter                  don't filter input files
  48 | 
  49 |   --strip                     strip all script and doc functionality from
  50 |                               ppport.h
  51 | 
  52 |   --list-provided             list provided API
  53 |   --list-unsupported          list unsupported API
  54 |   --api-info=name             show Perl API portability information
  55 | 
  56 | =head1 COMPATIBILITY
  57 | 
  58 | This version of F<ppport.h> is designed to support operation with Perl
  59 | installations back to 5.003, and has been tested up to 5.11.5.
  60 | 
  61 | =head1 OPTIONS
  62 | 
  63 | =head2 --help
  64 | 
  65 | Display a brief usage summary.
  66 | 
  67 | =head2 --version
  68 | 
  69 | Display the version of F<ppport.h>.
  70 | 
  71 | =head2 --patch=I<file>
  72 | 
  73 | If this option is given, a single patch file will be created if
  74 | any changes are suggested. This requires a working diff program
  75 | to be installed on your system.
  76 | 
  77 | =head2 --copy=I<suffix>
  78 | 
  79 | If this option is given, a copy of each file will be saved with
  80 | the given suffix that contains the suggested changes. This does
  81 | not require any external programs. Note that this does not
  82 | automagially add a dot between the original filename and the
  83 | suffix. If you want the dot, you have to include it in the option
  84 | argument.
  85 | 
  86 | If neither C<--patch> or C<--copy> are given, the default is to
  87 | simply print the diffs for each file. This requires either
  88 | C<Text::Diff> or a C<diff> program to be installed.
  89 | 
  90 | =head2 --diff=I<program>
  91 | 
  92 | Manually set the diff program and options to use. The default
  93 | is to use C<Text::Diff>, when installed, and output unified
  94 | context diffs.
  95 | 
  96 | =head2 --compat-version=I<version>
  97 | 
  98 | Tell F<ppport.h> to check for compatibility with the given
  99 | Perl version. The default is to check for compatibility with Perl
 100 | version 5.003. You can use this option to reduce the output
 101 | of F<ppport.h> if you intend to be backward compatible only
 102 | down to a certain Perl version.
 103 | 
 104 | =head2 --cplusplus
 105 | 
 106 | Usually, F<ppport.h> will detect C++ style comments and
 107 | replace them with C style comments for portability reasons.
 108 | Using this option instructs F<ppport.h> to leave C++
 109 | comments untouched.
 110 | 
 111 | =head2 --quiet
 112 | 
 113 | Be quiet. Don't print anything except fatal errors.
 114 | 
 115 | =head2 --nodiag
 116 | 
 117 | Don't output any diagnostic messages. Only portability
 118 | alerts will be printed.
 119 | 
 120 | =head2 --nohints
 121 | 
 122 | Don't output any hints. Hints often contain useful portability
 123 | notes. Warnings will still be displayed.
 124 | 
 125 | =head2 --nochanges
 126 | 
 127 | Don't suggest any changes. Only give diagnostic output and hints
 128 | unless these are also deactivated.
 129 | 
 130 | =head2 --nofilter
 131 | 
 132 | Don't filter the list of input files. By default, files not looking
 133 | like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
 134 | 
 135 | =head2 --strip
 136 | 
 137 | Strip all script and documentation functionality from F<ppport.h>.
 138 | This reduces the size of F<ppport.h> dramatically and may be useful
 139 | if you want to include F<ppport.h> in smaller modules without
 140 | increasing their distribution size too much.
 141 | 
 142 | The stripped F<ppport.h> will have a C<--unstrip> option that allows
 143 | you to undo the stripping, but only if an appropriate C<Devel::PPPort>
 144 | module is installed.
 145 | 
 146 | =head2 --list-provided
 147 | 
 148 | Lists the API elements for which compatibility is provided by
 149 | F<ppport.h>. Also lists if it must be explicitly requested,
 150 | if it has dependencies, and if there are hints or warnings for it.
 151 | 
 152 | =head2 --list-unsupported
 153 | 
 154 | Lists the API elements that are known not to be supported by
 155 | F<ppport.h> and below which version of Perl they probably
 156 | won't be available or work.
 157 | 
 158 | =head2 --api-info=I<name>
 159 | 
 160 | Show portability information for API elements matching I<name>.
 161 | If I<name> is surrounded by slashes, it is interpreted as a regular
 162 | expression.
 163 | 
 164 | =head1 DESCRIPTION
 165 | 
 166 | In order for a Perl extension (XS) module to be as portable as possible
 167 | across differing versions of Perl itself, certain steps need to be taken.
 168 | 
 169 | =over 4
 170 | 
 171 | =item *
 172 | 
 173 | Including this header is the first major one. This alone will give you
 174 | access to a large part of the Perl API that hasn't been available in
 175 | earlier Perl releases. Use
 176 | 
 177 |     perl ppport.h --list-provided
 178 | 
 179 | to see which API elements are provided by ppport.h.
 180 | 
 181 | =item *
 182 | 
 183 | You should avoid using deprecated parts of the API. For example, using
 184 | global Perl variables without the C<PL_> prefix is deprecated. Also,
 185 | some API functions used to have a C<perl_> prefix. Using this form is
 186 | also deprecated. You can safely use the supported API, as F<ppport.h>
 187 | will provide wrappers for older Perl versions.
 188 | 
 189 | =item *
 190 | 
 191 | If you use one of a few functions or variables that were not present in
 192 | earlier versions of Perl, and that can't be provided using a macro, you
 193 | have to explicitly request support for these functions by adding one or
 194 | more C<#define>s in your source code before the inclusion of F<ppport.h>.
 195 | 
 196 | These functions or variables will be marked C<explicit> in the list shown
 197 | by C<--list-provided>.
 198 | 
 199 | Depending on whether you module has a single or multiple files that
 200 | use such functions or variables, you want either C<static> or global
 201 | variants.
 202 | 
 203 | For a C<static> function or variable (used only in a single source
 204 | file), use:
 205 | 
 206 |     #define NEED_function
 207 |     #define NEED_variable
 208 | 
 209 | For a global function or variable (used in multiple source files),
 210 | use:
 211 | 
 212 |     #define NEED_function_GLOBAL
 213 |     #define NEED_variable_GLOBAL
 214 | 
 215 | Note that you mustn't have more than one global request for the
 216 | same function or variable in your project.
 217 | 
 218 |     Function / Variable       Static Request               Global Request
 219 |     -----------------------------------------------------------------------------------------
 220 |     PL_parser                 NEED_PL_parser               NEED_PL_parser_GLOBAL
 221 |     PL_signals                NEED_PL_signals              NEED_PL_signals_GLOBAL
 222 |     eval_pv()                 NEED_eval_pv                 NEED_eval_pv_GLOBAL
 223 |     grok_bin()                NEED_grok_bin                NEED_grok_bin_GLOBAL
 224 |     grok_hex()                NEED_grok_hex                NEED_grok_hex_GLOBAL
 225 |     grok_number()             NEED_grok_number             NEED_grok_number_GLOBAL
 226 |     grok_numeric_radix()      NEED_grok_numeric_radix      NEED_grok_numeric_radix_GLOBAL
 227 |     grok_oct()                NEED_grok_oct                NEED_grok_oct_GLOBAL
 228 |     load_module()             NEED_load_module             NEED_load_module_GLOBAL
 229 |     my_snprintf()             NEED_my_snprintf             NEED_my_snprintf_GLOBAL
 230 |     my_sprintf()              NEED_my_sprintf              NEED_my_sprintf_GLOBAL
 231 |     my_strlcat()              NEED_my_strlcat              NEED_my_strlcat_GLOBAL
 232 |     my_strlcpy()              NEED_my_strlcpy              NEED_my_strlcpy_GLOBAL
 233 |     newCONSTSUB()             NEED_newCONSTSUB             NEED_newCONSTSUB_GLOBAL
 234 |     newRV_noinc()             NEED_newRV_noinc             NEED_newRV_noinc_GLOBAL
 235 |     newSV_type()              NEED_newSV_type              NEED_newSV_type_GLOBAL
 236 |     newSVpvn_flags()          NEED_newSVpvn_flags          NEED_newSVpvn_flags_GLOBAL
 237 |     newSVpvn_share()          NEED_newSVpvn_share          NEED_newSVpvn_share_GLOBAL
 238 |     pv_display()              NEED_pv_display              NEED_pv_display_GLOBAL
 239 |     pv_escape()               NEED_pv_escape               NEED_pv_escape_GLOBAL
 240 |     pv_pretty()               NEED_pv_pretty               NEED_pv_pretty_GLOBAL
 241 |     sv_2pv_flags()            NEED_sv_2pv_flags            NEED_sv_2pv_flags_GLOBAL
 242 |     sv_2pvbyte()              NEED_sv_2pvbyte              NEED_sv_2pvbyte_GLOBAL
 243 |     sv_catpvf_mg()            NEED_sv_catpvf_mg            NEED_sv_catpvf_mg_GLOBAL
 244 |     sv_catpvf_mg_nocontext()  NEED_sv_catpvf_mg_nocontext  NEED_sv_catpvf_mg_nocontext_GLOBAL
 245 |     sv_pvn_force_flags()      NEED_sv_pvn_force_flags      NEED_sv_pvn_force_flags_GLOBAL
 246 |     sv_setpvf_mg()            NEED_sv_setpvf_mg            NEED_sv_setpvf_mg_GLOBAL
 247 |     sv_setpvf_mg_nocontext()  NEED_sv_setpvf_mg_nocontext  NEED_sv_setpvf_mg_nocontext_GLOBAL
 248 |     vload_module()            NEED_vload_module            NEED_vload_module_GLOBAL
 249 |     vnewSVpvf()               NEED_vnewSVpvf               NEED_vnewSVpvf_GLOBAL
 250 |     warner()                  NEED_warner                  NEED_warner_GLOBAL
 251 | 
 252 | To avoid namespace conflicts, you can change the namespace of the
 253 | explicitly exported functions / variables using the C<DPPP_NAMESPACE>
 254 | macro. Just C<#define> the macro before including C<ppport.h>:
 255 | 
 256 |     #define DPPP_NAMESPACE MyOwnNamespace_
 257 |     #include "ppport.h"
 258 | 
 259 | The default namespace is C<DPPP_>.
 260 | 
 261 | =back
 262 | 
 263 | The good thing is that most of the above can be checked by running
 264 | F<ppport.h> on your source code. See the next section for
 265 | details.
 266 | 
 267 | =head1 EXAMPLES
 268 | 
 269 | To verify whether F<ppport.h> is needed for your module, whether you
 270 | should make any changes to your code, and whether any special defines
 271 | should be used, F<ppport.h> can be run as a Perl script to check your
 272 | source code. Simply say:
 273 | 
 274 |     perl ppport.h
 275 | 
 276 | The result will usually be a list of patches suggesting changes
 277 | that should at least be acceptable, if not necessarily the most
 278 | efficient solution, or a fix for all possible problems.
 279 | 
 280 | If you know that your XS module uses features only available in
 281 | newer Perl releases, if you're aware that it uses C++ comments,
 282 | and if you want all suggestions as a single patch file, you could
 283 | use something like this:
 284 | 
 285 |     perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
 286 | 
 287 | If you only want your code to be scanned without any suggestions
 288 | for changes, use:
 289 | 
 290 |     perl ppport.h --nochanges
 291 | 
 292 | You can specify a different C<diff> program or options, using
 293 | the C<--diff> option:
 294 | 
 295 |     perl ppport.h --diff='diff -C 10'
 296 | 
 297 | This would output context diffs with 10 lines of context.
 298 | 
 299 | If you want to create patched copies of your files instead, use:
 300 | 
 301 |     perl ppport.h --copy=.new
 302 | 
 303 | To display portability information for the C<newSVpvn> function,
 304 | use:
 305 | 
 306 |     perl ppport.h --api-info=newSVpvn
 307 | 
 308 | Since the argument to C<--api-info> can be a regular expression,
 309 | you can use
 310 | 
 311 |     perl ppport.h --api-info=/_nomg$/
 312 | 
 313 | to display portability information for all C<_nomg> functions or
 314 | 
 315 |     perl ppport.h --api-info=/./
 316 | 
 317 | to display information for all known API elements.
 318 | 
 319 | =head1 BUGS
 320 | 
 321 | If this version of F<ppport.h> is causing failure during
 322 | the compilation of this module, please check if newer versions
 323 | of either this module or C<Devel::PPPort> are available on CPAN
 324 | before sending a bug report.
 325 | 
 326 | If F<ppport.h> was generated using the latest version of
 327 | C<Devel::PPPort> and is causing failure of this module, please
 328 | file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
 329 | 
 330 | Please include the following information:
 331 | 
 332 | =over 4
 333 | 
 334 | =item 1.
 335 | 
 336 | The complete output from running "perl -V"
 337 | 
 338 | =item 2.
 339 | 
 340 | This file.
 341 | 
 342 | =item 3.
 343 | 
 344 | The name and version of the module you were trying to build.
 345 | 
 346 | =item 4.
 347 | 
 348 | A full log of the build that failed.
 349 | 
 350 | =item 5.
 351 | 
 352 | Any other information that you think could be relevant.
 353 | 
 354 | =back
 355 | 
 356 | For the latest version of this code, please get the C<Devel::PPPort>
 357 | module from CPAN.
 358 | 
 359 | =head1 COPYRIGHT
 360 | 
 361 | Version 3.x, Copyright (c) 2004-2010, Marcus Holland-Moritz.
 362 | 
 363 | Version 2.x, Copyright (C) 2001, Paul Marquess.
 364 | 
 365 | Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
 366 | 
 367 | This program is free software; you can redistribute it and/or
 368 | modify it under the same terms as Perl itself.
 369 | 
 370 | =head1 SEE ALSO
 371 | 
 372 | See L<Devel::PPPort>.
 373 | 
 374 | =cut
 375 | 
 376 | use strict;
 377 | 
 378 | # Disable broken TRIE-optimization
 379 | BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
 380 | 
 381 | my $VERSION = 3.20;
 382 | 
 383 | my %opt = (
 384 |   quiet     => 0,
 385 |   diag      => 1,
 386 |   hints     => 1,
 387 |   changes   => 1,
 388 |   cplusplus => 0,
 389 |   filter    => 1,
 390 |   strip     => 0,
 391 |   version   => 0,
 392 | );
 393 | 
 394 | my($ppport) = $0 =~ /([\w.]+)$/;
 395 | my $LF = '(?:\r\n|[\r\n])';   # line feed
 396 | my $HS = "[ \t]";             # horizontal whitespace
 397 | 
 398 | # Never use C comments in this file!
 399 | my $ccs  = '/'.'*';
 400 | my $cce  = '*'.'/';
 401 | my $rccs = quotemeta $ccs;
 402 | my $rcce = quotemeta $cce;
 403 | 
 404 | eval {
 405 |   require Getopt::Long;
 406 |   Getopt::Long::GetOptions(\%opt, qw(
 407 |     help quiet diag! filter! hints! changes! cplusplus strip version
 408 |     patch=s copy=s diff=s compat-version=s
 409 |     list-provided list-unsupported api-info=s
 410 |   )) or usage();
 411 | };
 412 | 
 413 | if ($@ and grep /^-/, @ARGV) {
 414 |   usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
 415 |   die "Getopt::Long not found. Please don't use any options.\n";
 416 | }
 417 | 
 418 | if ($opt{version}) {
 419 |   print "This is $0 $VERSION.\n";
 420 |   exit 0;
 421 | }
 422 | 
 423 | usage() if $opt{help};
 424 | strip() if $opt{strip};
 425 | 
 426 | if (exists $opt{'compat-version'}) {
 427 |   my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
 428 |   if ($@) {
 429 |     die "Invalid version number format: '$opt{'compat-version'}'\n";
 430 |   }
 431 |   die "Only Perl 5 is supported\n" if $r != 5;
 432 |   die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
 433 |   $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
 434 | }
 435 | else {
 436 |   $opt{'compat-version'} = 5;
 437 | }
 438 | 
 439 | my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
 440 |                 ? ( $1 => {
 441 |                       ($2                  ? ( base     => $2 ) : ()),
 442 |                       ($3                  ? ( todo     => $3 ) : ()),
 443 |                       (index($4, 'v') >= 0 ? ( varargs  => 1  ) : ()),
 444 |                       (index($4, 'p') >= 0 ? ( provided => 1  ) : ()),
 445 |                       (index($4, 'n') >= 0 ? ( nothxarg => 1  ) : ()),
 446 |                     } )
 447 |                 : die "invalid spec: $_" } qw(
 448 | AvFILLp|5.004050||p
 449 | AvFILL|||
 450 | BhkDISABLE||5.014000|
 451 | BhkENABLE||5.014000|
 452 | BhkENTRY_set||5.014000|
 453 | BhkENTRY|||
 454 | BhkFLAGS|||
 455 | CALL_BLOCK_HOOKS|||
 456 | CLASS|||n
 457 | CPERLscope|5.005000||p
 458 | CX_CURPAD_SAVE|||
 459 | CX_CURPAD_SV|||
 460 | CopFILEAV|5.006000||p
 461 | CopFILEGV_set|5.006000||p
 462 | CopFILEGV|5.006000||p
 463 | CopFILESV|5.006000||p
 464 | CopFILE_set|5.006000||p
 465 | CopFILE|5.006000||p
 466 | CopSTASHPV_set|5.006000||p
 467 | CopSTASHPV|5.006000||p
 468 | CopSTASH_eq|5.006000||p
 469 | CopSTASH_set|5.006000||p
 470 | CopSTASH|5.006000||p
 471 | CopyD|5.009002||p
 472 | Copy|||
 473 | CvPADLIST|||
 474 | CvSTASH|||
 475 | CvWEAKOUTSIDE|||
 476 | DEFSV_set|5.010001||p
 477 | DEFSV|5.004050||p
 478 | END_EXTERN_C|5.005000||p
 479 | ENTER|||
 480 | ERRSV|5.004050||p
 481 | EXTEND|||
 482 | EXTERN_C|5.005000||p
 483 | F0convert|||n
 484 | FREETMPS|||
 485 | GIMME_V||5.004000|n
 486 | GIMME|||n
 487 | GROK_NUMERIC_RADIX|5.007002||p
 488 | G_ARRAY|||
 489 | G_DISCARD|||
 490 | G_EVAL|||
 491 | G_METHOD|5.006001||p
 492 | G_NOARGS|||
 493 | G_SCALAR|||
 494 | G_VOID||5.004000|
 495 | GetVars|||
 496 | GvSVn|5.009003||p
 497 | GvSV|||
 498 | Gv_AMupdate||5.011000|
 499 | HEf_SVKEY||5.004000|
 500 | HeHASH||5.004000|
 501 | HeKEY||5.004000|
 502 | HeKLEN||5.004000|
 503 | HePV||5.004000|
 504 | HeSVKEY_force||5.004000|
 505 | HeSVKEY_set||5.004000|
 506 | HeSVKEY||5.004000|
 507 | HeUTF8||5.010001|
 508 | HeVAL||5.004000|
 509 | HvENAME||5.013007|
 510 | HvNAMELEN_get|5.009003||p
 511 | HvNAME_get|5.009003||p
 512 | HvNAME|||
 513 | INT2PTR|5.006000||p
 514 | IN_LOCALE_COMPILETIME|5.007002||p
 515 | IN_LOCALE_RUNTIME|5.007002||p
 516 | IN_LOCALE|5.007002||p
 517 | IN_PERL_COMPILETIME|5.008001||p
 518 | IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
 519 | IS_NUMBER_INFINITY|5.007002||p
 520 | IS_NUMBER_IN_UV|5.007002||p
 521 | IS_NUMBER_NAN|5.007003||p
 522 | IS_NUMBER_NEG|5.007002||p
 523 | IS_NUMBER_NOT_INT|5.007002||p
 524 | IVSIZE|5.006000||p
 525 | IVTYPE|5.006000||p
 526 | IVdf|5.006000||p
 527 | LEAVE|||
 528 | LINKLIST||5.013006|
 529 | LVRET|||
 530 | MARK|||
 531 | MULTICALL||5.014000|
 532 | MY_CXT_CLONE|5.009002||p
 533 | MY_CXT_INIT|5.007003||p
 534 | MY_CXT|5.007003||p
 535 | MoveD|5.009002||p
 536 | Move|||
 537 | NOOP|5.005000||p
 538 | NUM2PTR|5.006000||p
 539 | NVTYPE|5.006000||p
 540 | NVef|5.006001||p
 541 | NVff|5.006001||p
 542 | NVgf|5.006001||p
 543 | Newxc|5.009003||p
 544 | Newxz|5.009003||p
 545 | Newx|5.009003||p
 546 | Nullav|||
 547 | Nullch|||
 548 | Nullcv|||
 549 | Nullhv|||
 550 | Nullsv|||
 551 | OP_CLASS||5.013007|
 552 | OP_DESC||5.007003|
 553 | OP_NAME||5.007003|
 554 | ORIGMARK|||
 555 | PAD_BASE_SV|||
 556 | PAD_CLONE_VARS|||
 557 | PAD_COMPNAME_FLAGS|||
 558 | PAD_COMPNAME_GEN_set|||
 559 | PAD_COMPNAME_GEN|||
 560 | PAD_COMPNAME_OURSTASH|||
 561 | PAD_COMPNAME_PV|||
 562 | PAD_COMPNAME_TYPE|||
 563 | PAD_DUP|||
 564 | PAD_RESTORE_LOCAL|||
 565 | PAD_SAVE_LOCAL|||
 566 | PAD_SAVE_SETNULLPAD|||
 567 | PAD_SETSV|||
 568 | PAD_SET_CUR_NOSAVE|||
 569 | PAD_SET_CUR|||
 570 | PAD_SVl|||
 571 | PAD_SV|||
 572 | PERLIO_FUNCS_CAST|5.009003||p
 573 | PERLIO_FUNCS_DECL|5.009003||p
 574 | PERL_ABS|5.008001||p
 575 | PERL_BCDVERSION|5.014000||p
 576 | PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
 577 | PERL_HASH|5.004000||p
 578 | PERL_INT_MAX|5.004000||p
 579 | PERL_INT_MIN|5.004000||p
 580 | PERL_LONG_MAX|5.004000||p
 581 | PERL_LONG_MIN|5.004000||p
 582 | PERL_MAGIC_arylen|5.007002||p
 583 | PERL_MAGIC_backref|5.007002||p
 584 | PERL_MAGIC_bm|5.007002||p
 585 | PERL_MAGIC_collxfrm|5.007002||p
 586 | PERL_MAGIC_dbfile|5.007002||p
 587 | PERL_MAGIC_dbline|5.007002||p
 588 | PERL_MAGIC_defelem|5.007002||p
 589 | PERL_MAGIC_envelem|5.007002||p
 590 | PERL_MAGIC_env|5.007002||p
 591 | PERL_MAGIC_ext|5.007002||p
 592 | PERL_MAGIC_fm|5.007002||p
 593 | PERL_MAGIC_glob|5.014000||p
 594 | PERL_MAGIC_isaelem|5.007002||p
 595 | PERL_MAGIC_isa|5.007002||p
 596 | PERL_MAGIC_mutex|5.014000||p
 597 | PERL_MAGIC_nkeys|5.007002||p
 598 | PERL_MAGIC_overload_elem|5.007002||p
 599 | PERL_MAGIC_overload_table|5.007002||p
 600 | PERL_MAGIC_overload|5.007002||p
 601 | PERL_MAGIC_pos|5.007002||p
 602 | PERL_MAGIC_qr|5.007002||p
 603 | PERL_MAGIC_regdata|5.007002||p
 604 | PERL_MAGIC_regdatum|5.007002||p
 605 | PERL_MAGIC_regex_global|5.007002||p
 606 | PERL_MAGIC_shared_scalar|5.007003||p
 607 | PERL_MAGIC_shared|5.007003||p
 608 | PERL_MAGIC_sigelem|5.007002||p
 609 | PERL_MAGIC_sig|5.007002||p
 610 | PERL_MAGIC_substr|5.007002||p
 611 | PERL_MAGIC_sv|5.007002||p
 612 | PERL_MAGIC_taint|5.007002||p
 613 | PERL_MAGIC_tiedelem|5.007002||p
 614 | PERL_MAGIC_tiedscalar|5.007002||p
 615 | PERL_MAGIC_tied|5.007002||p
 616 | PERL_MAGIC_utf8|5.008001||p
 617 | PERL_MAGIC_uvar_elem|5.007003||p
 618 | PERL_MAGIC_uvar|5.007002||p
 619 | PERL_MAGIC_vec|5.007002||p
 620 | PERL_MAGIC_vstring|5.008001||p
 621 | PERL_PV_ESCAPE_ALL|5.009004||p
 622 | PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
 623 | PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
 624 | PERL_PV_ESCAPE_NOCLEAR|5.009004||p
 625 | PERL_PV_ESCAPE_QUOTE|5.009004||p
 626 | PERL_PV_ESCAPE_RE|5.009005||p
 627 | PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
 628 | PERL_PV_ESCAPE_UNI|5.009004||p
 629 | PERL_PV_PRETTY_DUMP|5.009004||p
 630 | PERL_PV_PRETTY_ELLIPSES|5.010000||p
 631 | PERL_PV_PRETTY_LTGT|5.009004||p
 632 | PERL_PV_PRETTY_NOCLEAR|5.010000||p
 633 | PERL_PV_PRETTY_QUOTE|5.009004||p
 634 | PERL_PV_PRETTY_REGPROP|5.009004||p
 635 | PERL_QUAD_MAX|5.004000||p
 636 | PERL_QUAD_MIN|5.004000||p
 637 | PERL_REVISION|5.006000||p
 638 | PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
 639 | PERL_SCAN_DISALLOW_PREFIX|5.007003||p
 640 | PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
 641 | PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
 642 | PERL_SHORT_MAX|5.004000||p
 643 | PERL_SHORT_MIN|5.004000||p
 644 | PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
 645 | PERL_SUBVERSION|5.006000||p
 646 | PERL_SYS_INIT3||5.006000|
 647 | PERL_SYS_INIT|||
 648 | PERL_SYS_TERM||5.014000|
 649 | PERL_UCHAR_MAX|5.004000||p
 650 | PERL_UCHAR_MIN|5.004000||p
 651 | PERL_UINT_MAX|5.004000||p
 652 | PERL_UINT_MIN|5.004000||p
 653 | PERL_ULONG_MAX|5.004000||p
 654 | PERL_ULONG_MIN|5.004000||p
 655 | PERL_UNUSED_ARG|5.009003||p
 656 | PERL_UNUSED_CONTEXT|5.009004||p
 657 | PERL_UNUSED_DECL|5.007002||p
 658 | PERL_UNUSED_VAR|5.007002||p
 659 | PERL_UQUAD_MAX|5.004000||p
 660 | PERL_UQUAD_MIN|5.004000||p
 661 | PERL_USE_GCC_BRACE_GROUPS|5.009004||p
 662 | PERL_USHORT_MAX|5.004000||p
 663 | PERL_USHORT_MIN|5.004000||p
 664 | PERL_VERSION|5.006000||p
 665 | PL_DBsignal|5.005000||p
 666 | PL_DBsingle|||pn
 667 | PL_DBsub|||pn
 668 | PL_DBtrace|||pn
 669 | PL_Sv|5.005000||p
 670 | PL_bufend|5.014000||p
 671 | PL_bufptr|5.014000||p
 672 | PL_compiling|5.004050||p
 673 | PL_copline|5.014000||p
 674 | PL_curcop|5.004050||p
 675 | PL_curstash|5.004050||p
 676 | PL_debstash|5.004050||p
 677 | PL_defgv|5.004050||p
 678 | PL_diehook|5.004050||p
 679 | PL_dirty|5.004050||p
 680 | PL_dowarn|||pn
 681 | PL_errgv|5.004050||p
 682 | PL_error_count|5.014000||p
 683 | PL_expect|5.014000||p
 684 | PL_hexdigit|5.005000||p
 685 | PL_hints|5.005000||p
 686 | PL_in_my_stash|5.014000||p
 687 | PL_in_my|5.014000||p
 688 | PL_keyword_plugin||5.011002|
 689 | PL_last_in_gv|||n
 690 | PL_laststatval|5.005000||p
 691 | PL_lex_state|5.014000||p
 692 | PL_lex_stuff|5.014000||p
 693 | PL_linestr|5.014000||p
 694 | PL_modglobal||5.005000|n
 695 | PL_na|5.004050||pn
 696 | PL_no_modify|5.006000||p
 697 | PL_ofsgv|||n
 698 | PL_opfreehook||5.011000|n
 699 | PL_parser|5.009005|5.009005|p
 700 | PL_peepp||5.007003|n
 701 | PL_perl_destruct_level|5.004050||p
 702 | PL_perldb|5.004050||p
 703 | PL_ppaddr|5.006000||p
 704 | PL_rpeepp||5.013005|n
 705 | PL_rsfp_filters|5.014000||p
 706 | PL_rsfp|5.014000||p
 707 | PL_rs|||n
 708 | PL_signals|5.008001||p
 709 | PL_stack_base|5.004050||p
 710 | PL_stack_sp|5.004050||p
 711 | PL_statcache|5.005000||p
 712 | PL_stdingv|5.004050||p
 713 | PL_sv_arenaroot|5.004050||p
 714 | PL_sv_no|5.004050||pn
 715 | PL_sv_undef|5.004050||pn
 716 | PL_sv_yes|5.004050||pn
 717 | PL_tainted|5.004050||p
 718 | PL_tainting|5.004050||p
 719 | PL_tokenbuf|5.014000||p
 720 | POP_MULTICALL||5.014000|
 721 | POPi|||n
 722 | POPl|||n
 723 | POPn|||n
 724 | POPpbytex||5.007001|n
 725 | POPpx||5.005030|n
 726 | POPp|||n
 727 | POPs|||n
 728 | PTR2IV|5.006000||p
 729 | PTR2NV|5.006000||p
 730 | PTR2UV|5.006000||p
 731 | PTR2nat|5.009003||p
 732 | PTR2ul|5.007001||p
 733 | PTRV|5.006000||p
 734 | PUSHMARK|||
 735 | PUSH_MULTICALL||5.014000|
 736 | PUSHi|||
 737 | PUSHmortal|5.009002||p
 738 | PUSHn|||
 739 | PUSHp|||
 740 | PUSHs|||
 741 | PUSHu|5.004000||p
 742 | PUTBACK|||
 743 | PerlIO_clearerr||5.007003|
 744 | PerlIO_close||5.007003|
 745 | PerlIO_context_layers||5.009004|
 746 | PerlIO_eof||5.007003|
 747 | PerlIO_error||5.007003|
 748 | PerlIO_fileno||5.007003|
 749 | PerlIO_fill||5.007003|
 750 | PerlIO_flush||5.007003|
 751 | PerlIO_get_base||5.007003|
 752 | PerlIO_get_bufsiz||5.007003|
 753 | PerlIO_get_cnt||5.007003|
 754 | PerlIO_get_ptr||5.007003|
 755 | PerlIO_read||5.007003|
 756 | PerlIO_seek||5.007003|
 757 | PerlIO_set_cnt||5.007003|
 758 | PerlIO_set_ptrcnt||5.007003|
 759 | PerlIO_setlinebuf||5.007003|
 760 | PerlIO_stderr||5.007003|
 761 | PerlIO_stdin||5.007003|
 762 | PerlIO_stdout||5.007003|
 763 | PerlIO_tell||5.007003|
 764 | PerlIO_unread||5.007003|
 765 | PerlIO_write||5.007003|
 766 | Perl_signbit||5.009005|n
 767 | PoisonFree|5.009004||p
 768 | PoisonNew|5.009004||p
 769 | PoisonWith|5.009004||p
 770 | Poison|5.008000||p
 771 | RETVAL|||n
 772 | Renewc|||
 773 | Renew|||
 774 | SAVECLEARSV|||
 775 | SAVECOMPPAD|||
 776 | SAVEPADSV|||
 777 | SAVETMPS|||
 778 | SAVE_DEFSV|5.004050||p
 779 | SPAGAIN|||
 780 | SP|||
 781 | START_EXTERN_C|5.005000||p
 782 | START_MY_CXT|5.007003||p
 783 | STMT_END|||p
 784 | STMT_START|||p
 785 | STR_WITH_LEN|5.009003||p
 786 | ST|||
 787 | SV_CONST_RETURN|5.009003||p
 788 | SV_COW_DROP_PV|5.008001||p
 789 | SV_COW_SHARED_HASH_KEYS|5.009005||p
 790 | SV_GMAGIC|5.007002||p
 791 | SV_HAS_TRAILING_NUL|5.009004||p
 792 | SV_IMMEDIATE_UNREF|5.007001||p
 793 | SV_MUTABLE_RETURN|5.009003||p
 794 | SV_NOSTEAL|5.009002||p
 795 | SV_SMAGIC|5.009003||p
 796 | SV_UTF8_NO_ENCODING|5.008001||p
 797 | SVfARG|5.009005||p
 798 | SVf_UTF8|5.006000||p
 799 | SVf|5.006000||p
 800 | SVt_IV|||
 801 | SVt_NV|||
 802 | SVt_PVAV|||
 803 | SVt_PVCV|||
 804 | SVt_PVHV|||
 805 | SVt_PVMG|||
 806 | SVt_PV|||
 807 | Safefree|||
 808 | Slab_Alloc|||
 809 | Slab_Free|||
 810 | Slab_to_rw|||
 811 | StructCopy|||
 812 | SvCUR_set|||
 813 | SvCUR|||
 814 | SvEND|||
 815 | SvGAMAGIC||5.006001|
 816 | SvGETMAGIC|5.004050||p
 817 | SvGROW|||
 818 | SvIOK_UV||5.006000|
 819 | SvIOK_notUV||5.006000|
 820 | SvIOK_off|||
 821 | SvIOK_only_UV||5.006000|
 822 | SvIOK_only|||
 823 | SvIOK_on|||
 824 | SvIOKp|||
 825 | SvIOK|||
 826 | SvIVX|||
 827 | SvIV_nomg|5.009001||p
 828 | SvIV_set|||
 829 | SvIVx|||
 830 | SvIV|||
 831 | SvIsCOW_shared_hash||5.008003|
 832 | SvIsCOW||5.008003|
 833 | SvLEN_set|||
 834 | SvLEN|||
 835 | SvLOCK||5.007003|
 836 | SvMAGIC_set|5.009003||p
 837 | SvNIOK_off|||
 838 | SvNIOKp|||
 839 | SvNIOK|||
 840 | SvNOK_off|||
 841 | SvNOK_only|||
 842 | SvNOK_on|||
 843 | SvNOKp|||
 844 | SvNOK|||
 845 | SvNVX|||
 846 | SvNV_nomg||5.013002|
 847 | SvNV_set|||
 848 | SvNVx|||
 849 | SvNV|||
 850 | SvOK|||
 851 | SvOOK_offset||5.011000|
 852 | SvOOK|||
 853 | SvPOK_off|||
 854 | SvPOK_only_UTF8||5.006000|
 855 | SvPOK_only|||
 856 | SvPOK_on|||
 857 | SvPOKp|||
 858 | SvPOK|||
 859 | SvPVX_const|5.009003||p
 860 | SvPVX_mutable|5.009003||p
 861 | SvPVX|||
 862 | SvPV_const|5.009003||p
 863 | SvPV_flags_const_nolen|5.009003||p
 864 | SvPV_flags_const|5.009003||p
 865 | SvPV_flags_mutable|5.009003||p
 866 | SvPV_flags|5.007002||p
 867 | SvPV_force_flags_mutable|5.009003||p
 868 | SvPV_force_flags_nolen|5.009003||p
 869 | SvPV_force_flags|5.007002||p
 870 | SvPV_force_mutable|5.009003||p
 871 | SvPV_force_nolen|5.009003||p
 872 | SvPV_force_nomg_nolen|5.009003||p
 873 | SvPV_force_nomg|5.007002||p
 874 | SvPV_force|||p
 875 | SvPV_mutable|5.009003||p
 876 | SvPV_nolen_const|5.009003||p
 877 | SvPV_nolen|5.006000||p
 878 | SvPV_nomg_const_nolen|5.009003||p
 879 | SvPV_nomg_const|5.009003||p
 880 | SvPV_nomg_nolen||5.013007|
 881 | SvPV_nomg|5.007002||p
 882 | SvPV_renew|5.009003||p
 883 | SvPV_set|||
 884 | SvPVbyte_force||5.009002|
 885 | SvPVbyte_nolen||5.006000|
 886 | SvPVbytex_force||5.006000|
 887 | SvPVbytex||5.006000|
 888 | SvPVbyte|5.006000||p
 889 | SvPVutf8_force||5.006000|
 890 | SvPVutf8_nolen||5.006000|
 891 | SvPVutf8x_force||5.006000|
 892 | SvPVutf8x||5.006000|
 893 | SvPVutf8||5.006000|
 894 | SvPVx|||
 895 | SvPV|||
 896 | SvREFCNT_dec|||
 897 | SvREFCNT_inc_NN|5.009004||p
 898 | SvREFCNT_inc_simple_NN|5.009004||p
 899 | SvREFCNT_inc_simple_void_NN|5.009004||p
 900 | SvREFCNT_inc_simple_void|5.009004||p
 901 | SvREFCNT_inc_simple|5.009004||p
 902 | SvREFCNT_inc_void_NN|5.009004||p
 903 | SvREFCNT_inc_void|5.009004||p
 904 | SvREFCNT_inc|||p
 905 | SvREFCNT|||
 906 | SvROK_off|||
 907 | SvROK_on|||
 908 | SvROK|||
 909 | SvRV_set|5.009003||p
 910 | SvRV|||
 911 | SvRXOK||5.009005|
 912 | SvRX||5.009005|
 913 | SvSETMAGIC|||
 914 | SvSHARED_HASH|5.009003||p
 915 | SvSHARE||5.007003|
 916 | SvSTASH_set|5.009003||p
 917 | SvSTASH|||
 918 | SvSetMagicSV_nosteal||5.004000|
 919 | SvSetMagicSV||5.004000|
 920 | SvSetSV_nosteal||5.004000|
 921 | SvSetSV|||
 922 | SvTAINTED_off||5.004000|
 923 | SvTAINTED_on||5.004000|
 924 | SvTAINTED||5.004000|
 925 | SvTAINT|||
 926 | SvTRUE_nomg||5.013006|
 927 | SvTRUE|||
 928 | SvTYPE|||
 929 | SvUNLOCK||5.007003|
 930 | SvUOK|5.007001|5.006000|p
 931 | SvUPGRADE|||
 932 | SvUTF8_off||5.006000|
 933 | SvUTF8_on||5.006000|
 934 | SvUTF8||5.006000|
 935 | SvUVXx|5.004000||p
 936 | SvUVX|5.004000||p
 937 | SvUV_nomg|5.009001||p
 938 | SvUV_set|5.009003||p
 939 | SvUVx|5.004000||p
 940 | SvUV|5.004000||p
 941 | SvVOK||5.008001|
 942 | SvVSTRING_mg|5.009004||p
 943 | THIS|||n
 944 | UNDERBAR|5.009002||p
 945 | UTF8_MAXBYTES|5.009002||p
 946 | UVSIZE|5.006000||p
 947 | UVTYPE|5.006000||p
 948 | UVXf|5.007001||p
 949 | UVof|5.006000||p
 950 | UVuf|5.006000||p
 951 | UVxf|5.006000||p
 952 | WARN_ALL|5.006000||p
 953 | WARN_AMBIGUOUS|5.006000||p
 954 | WARN_ASSERTIONS|5.014000||p
 955 | WARN_BAREWORD|5.006000||p
 956 | WARN_CLOSED|5.006000||p
 957 | WARN_CLOSURE|5.006000||p
 958 | WARN_DEBUGGING|5.006000||p
 959 | WARN_DEPRECATED|5.006000||p
 960 | WARN_DIGIT|5.006000||p
 961 | WARN_EXEC|5.006000||p
 962 | WARN_EXITING|5.006000||p
 963 | WARN_GLOB|5.006000||p
 964 | WARN_INPLACE|5.006000||p
 965 | WARN_INTERNAL|5.006000||p
 966 | WARN_IO|5.006000||p
 967 | WARN_LAYER|5.008000||p
 968 | WARN_MALLOC|5.006000||p
 969 | WARN_MISC|5.006000||p
 970 | WARN_NEWLINE|5.006000||p
 971 | WARN_NUMERIC|5.006000||p
 972 | WARN_ONCE|5.006000||p
 973 | WARN_OVERFLOW|5.006000||p
 974 | WARN_PACK|5.006000||p
 975 | WARN_PARENTHESIS|5.006000||p
 976 | WARN_PIPE|5.006000||p
 977 | WARN_PORTABLE|5.006000||p
 978 | WARN_PRECEDENCE|5.006000||p
 979 | WARN_PRINTF|5.006000||p
 980 | WARN_PROTOTYPE|5.006000||p
 981 | WARN_QW|5.006000||p
 982 | WARN_RECURSION|5.006000||p
 983 | WARN_REDEFINE|5.006000||p
 984 | WARN_REGEXP|5.006000||p
 985 | WARN_RESERVED|5.006000||p
 986 | WARN_SEMICOLON|5.006000||p
 987 | WARN_SEVERE|5.006000||p
 988 | WARN_SIGNAL|5.006000||p
 989 | WARN_SUBSTR|5.006000||p
 990 | WARN_SYNTAX|5.006000||p
 991 | WARN_TAINT|5.006000||p
 992 | WARN_THREADS|5.008000||p
 993 | WARN_UNINITIALIZED|5.006000||p
 994 | WARN_UNOPENED|5.006000||p
 995 | WARN_UNPACK|5.006000||p
 996 | WARN_UNTIE|5.006000||p
 997 | WARN_UTF8|5.006000||p
 998 | WARN_VOID|5.006000||p
 999 | XCPT_CATCH|5.009002||p
1000 | XCPT_RETHROW|5.009002||p
1001 | XCPT_TRY_END|5.009002||p
1002 | XCPT_TRY_START|5.009002||p
1003 | XPUSHi|||
1004 | XPUSHmortal|5.009002||p
1005 | XPUSHn|||
1006 | XPUSHp|||
1007 | XPUSHs|||
1008 | XPUSHu|5.004000||p
1009 | XSPROTO|5.010000||p
1010 | XSRETURN_EMPTY|||
1011 | XSRETURN_IV|||
1012 | XSRETURN_NO|||
1013 | XSRETURN_NV|||
1014 | XSRETURN_PV|||
1015 | XSRETURN_UNDEF|||
1016 | XSRETURN_UV|5.008001||p
1017 | XSRETURN_YES|||
1018 | XSRETURN|||p
1019 | XST_mIV|||
1020 | XST_mNO|||
1021 | XST_mNV|||
1022 | XST_mPV|||
1023 | XST_mUNDEF|||
1024 | XST_mUV|5.008001||p
1025 | XST_mYES|||
1026 | XS_APIVERSION_BOOTCHECK||5.013004|
1027 | XS_VERSION_BOOTCHECK|||
1028 | XS_VERSION|||
1029 | XSprePUSH|5.006000||p
1030 | XS|||
1031 | XopDISABLE||5.014000|
1032 | XopENABLE||5.014000|
1033 | XopENTRY_set||5.014000|
1034 | XopENTRY||5.014000|
1035 | XopFLAGS||5.013007|
1036 | ZeroD|5.009002||p
1037 | Zero|||
1038 | _aMY_CXT|5.007003||p
1039 | _append_range_to_invlist|||
1040 | _new_invlist|||
1041 | _pMY_CXT|5.007003||p
1042 | _swash_inversion_hash|||
1043 | _swash_to_invlist|||
1044 | aMY_CXT_|5.007003||p
1045 | aMY_CXT|5.007003||p
1046 | aTHXR_|5.014000||p
1047 | aTHXR|5.014000||p
1048 | aTHX_|5.006000||p
1049 | aTHX|5.006000||p
1050 | add_alternate|||
1051 | add_cp_to_invlist|||
1052 | add_data|||n
1053 | add_range_to_invlist|||
1054 | add_utf16_textfilter|||
1055 | addmad|||
1056 | allocmy|||
1057 | amagic_call|||
1058 | amagic_cmp_locale|||
1059 | amagic_cmp|||
1060 | amagic_deref_call||5.013007|
1061 | amagic_i_ncmp|||
1062 | amagic_ncmp|||
1063 | anonymise_cv_maybe|||
1064 | any_dup|||
1065 | ao|||
1066 | append_madprops|||
1067 | apply_attrs_my|||
1068 | apply_attrs_string||5.006001|
1069 | apply_attrs|||
1070 | apply|||
1071 | assert_uft8_cache_coherent|||
1072 | atfork_lock||5.007003|n
1073 | atfork_unlock||5.007003|n
1074 | av_arylen_p||5.009003|
1075 | av_clear|||
1076 | av_create_and_push||5.009005|
1077 | av_create_and_unshift_one||5.009005|
1078 | av_delete||5.006000|
1079 | av_exists||5.006000|
1080 | av_extend|||
1081 | av_fetch|||
1082 | av_fill|||
1083 | av_iter_p||5.011000|
1084 | av_len|||
1085 | av_make|||
1086 | av_pop|||
1087 | av_push|||
1088 | av_reify|||
1089 | av_shift|||
1090 | av_store|||
1091 | av_undef|||
1092 | av_unshift|||
1093 | ax|||n
1094 | bad_type|||
1095 | bind_match|||
1096 | block_end|||
1097 | block_gimme||5.004000|
1098 | block_start|||
1099 | blockhook_register||5.013003|
1100 | boolSV|5.004000||p
1101 | boot_core_PerlIO|||
1102 | boot_core_UNIVERSAL|||
1103 | boot_core_mro|||
1104 | bytes_cmp_utf8||5.013007|
1105 | bytes_from_utf8||5.007001|
1106 | bytes_to_uni|||n
1107 | bytes_to_utf8||5.006001|
1108 | call_argv|5.006000||p
1109 | call_atexit||5.006000|
1110 | call_list||5.004000|
1111 | call_method|5.006000||p
1112 | call_pv|5.006000||p
1113 | call_sv|5.006000||p
1114 | caller_cx||5.013005|
1115 | calloc||5.007002|n
1116 | cando|||
1117 | cast_i32||5.006000|
1118 | cast_iv||5.006000|
1119 | cast_ulong||5.006000|
1120 | cast_uv||5.006000|
1121 | check_type_and_open|||
1122 | check_uni|||
1123 | check_utf8_print|||
1124 | checkcomma|||
1125 | checkposixcc|||
1126 | ckWARN|5.006000||p
1127 | ck_entersub_args_list||5.013006|
1128 | ck_entersub_args_proto_or_list||5.013006|
1129 | ck_entersub_args_proto||5.013006|
1130 | ck_warner_d||5.011001|v
1131 | ck_warner||5.011001|v
1132 | ckwarn_common|||
1133 | ckwarn_d||5.009003|
1134 | ckwarn||5.009003|
1135 | cl_and|||n
1136 | cl_anything|||n
1137 | cl_init|||n
1138 | cl_is_anything|||n
1139 | cl_or|||n
1140 | clear_placeholders|||
1141 | clone_params_del|||n
1142 | clone_params_new|||n
1143 | closest_cop|||
1144 | convert|||
1145 | cop_free|||
1146 | cop_hints_2hv||5.013007|
1147 | cop_hints_fetch_pvn||5.013007|
1148 | cop_hints_fetch_pvs||5.013007|
1149 | cop_hints_fetch_pv||5.013007|
1150 | cop_hints_fetch_sv||5.013007|
1151 | cophh_2hv||5.013007|
1152 | cophh_copy||5.013007|
1153 | cophh_delete_pvn||5.013007|
1154 | cophh_delete_pvs||5.013007|
1155 | cophh_delete_pv||5.013007|
1156 | cophh_delete_sv||5.013007|
1157 | cophh_fetch_pvn||5.013007|
1158 | cophh_fetch_pvs||5.013007|
1159 | cophh_fetch_pv||5.013007|
1160 | cophh_fetch_sv||5.013007|
1161 | cophh_free||5.013007|
1162 | cophh_new_empty||5.014000|
1163 | cophh_store_pvn||5.013007|
1164 | cophh_store_pvs||5.013007|
1165 | cophh_store_pv||5.013007|
1166 | cophh_store_sv||5.013007|
1167 | cr_textfilter|||
1168 | create_eval_scope|||
1169 | croak_no_modify||5.013003|
1170 | croak_nocontext|||vn
1171 | croak_sv||5.013001|
1172 | croak_xs_usage||5.010001|
1173 | croak|||v
1174 | csighandler||5.009003|n
1175 | curmad|||
1176 | curse|||
1177 | custom_op_desc||5.007003|
1178 | custom_op_name||5.007003|
1179 | custom_op_register||5.013007|
1180 | custom_op_xop||5.013007|
1181 | cv_ckproto_len|||
1182 | cv_clone|||
1183 | cv_const_sv||5.004000|
1184 | cv_dump|||
1185 | cv_get_call_checker||5.013006|
1186 | cv_set_call_checker||5.013006|
1187 | cv_undef|||
1188 | cvgv_set|||
1189 | cvstash_set|||
1190 | cx_dump||5.005000|
1191 | cx_dup|||
1192 | cxinc|||
1193 | dAXMARK|5.009003||p
1194 | dAX|5.007002||p
1195 | dITEMS|5.007002||p
1196 | dMARK|||
1197 | dMULTICALL||5.009003|
1198 | dMY_CXT_SV|5.007003||p
1199 | dMY_CXT|5.007003||p
1200 | dNOOP|5.006000||p
1201 | dORIGMARK|||
1202 | dSP|||
1203 | dTHR|5.004050||p
1204 | dTHXR|5.014000||p
1205 | dTHXa|5.006000||p
1206 | dTHXoa|5.006000||p
1207 | dTHX|5.006000||p
1208 | dUNDERBAR|5.009002||p
1209 | dVAR|5.009003||p
1210 | dXCPT|5.009002||p
1211 | dXSARGS|||
1212 | dXSI32|||
1213 | dXSTARG|5.006000||p
1214 | deb_curcv|||
1215 | deb_nocontext|||vn
1216 | deb_stack_all|||
1217 | deb_stack_n|||
1218 | debop||5.005000|
1219 | debprofdump||5.005000|
1220 | debprof|||
1221 | debstackptrs||5.007003|
1222 | debstack||5.007003|
1223 | debug_start_match|||
1224 | deb||5.007003|v
1225 | del_sv|||
1226 | delete_eval_scope|||
1227 | delimcpy||5.004000|n
1228 | deprecate_commaless_var_list|||
1229 | despatch_signals||5.007001|
1230 | destroy_matcher|||
1231 | die_nocontext|||vn
1232 | die_sv||5.013001|
1233 | die_unwind|||
1234 | die|||v
1235 | dirp_dup|||
1236 | div128|||
1237 | djSP|||
1238 | do_aexec5|||
1239 | do_aexec|||
1240 | do_aspawn|||
1241 | do_binmode||5.004050|
1242 | do_chomp|||
1243 | do_close|||
1244 | do_delete_local|||
1245 | do_dump_pad|||
1246 | do_eof|||
1247 | do_exec3|||
1248 | do_execfree|||
1249 | do_exec|||
1250 | do_gv_dump||5.006000|
1251 | do_gvgv_dump||5.006000|
1252 | do_hv_dump||5.006000|
1253 | do_ipcctl|||
1254 | do_ipcget|||
1255 | do_join|||
1256 | do_magic_dump||5.006000|
1257 | do_msgrcv|||
1258 | do_msgsnd|||
1259 | do_oddball|||
1260 | do_op_dump||5.006000|
1261 | do_op_xmldump|||
1262 | do_open9||5.006000|
1263 | do_openn||5.007001|
1264 | do_open||5.004000|
1265 | do_pmop_dump||5.006000|
1266 | do_pmop_xmldump|||
1267 | do_print|||
1268 | do_readline|||
1269 | do_seek|||
1270 | do_semop|||
1271 | do_shmio|||
1272 | do_smartmatch|||
1273 | do_spawn_nowait|||
1274 | do_spawn|||
1275 | do_sprintf|||
1276 | do_sv_dump||5.006000|
1277 | do_sysseek|||
1278 | do_tell|||
1279 | do_trans_complex_utf8|||
1280 | do_trans_complex|||
1281 | do_trans_count_utf8|||
1282 | do_trans_count|||
1283 | do_trans_simple_utf8|||
1284 | do_trans_simple|||
1285 | do_trans|||
1286 | do_vecget|||
1287 | do_vecset|||
1288 | do_vop|||
1289 | docatch|||
1290 | doeval|||
1291 | dofile|||
1292 | dofindlabel|||
1293 | doform|||
1294 | doing_taint||5.008001|n
1295 | dooneliner|||
1296 | doopen_pm|||
1297 | doparseform|||
1298 | dopoptoeval|||
1299 | dopoptogiven|||
1300 | dopoptolabel|||
1301 | dopoptoloop|||
1302 | dopoptosub_at|||
1303 | dopoptowhen|||
1304 | doref||5.009003|
1305 | dounwind|||
1306 | dowantarray|||
1307 | dump_all_perl|||
1308 | dump_all||5.006000|
1309 | dump_eval||5.006000|
1310 | dump_exec_pos|||
1311 | dump_fds|||
1312 | dump_form||5.006000|
1313 | dump_indent||5.006000|v
1314 | dump_mstats|||
1315 | dump_packsubs_perl|||
1316 | dump_packsubs||5.006000|
1317 | dump_sub_perl|||
1318 | dump_sub||5.006000|
1319 | dump_sv_child|||
1320 | dump_trie_interim_list|||
1321 | dump_trie_interim_table|||
1322 | dump_trie|||
1323 | dump_vindent||5.006000|
1324 | dumpuntil|||
1325 | dup_attrlist|||
1326 | emulate_cop_io|||
1327 | eval_pv|5.006000||p
1328 | eval_sv|5.006000||p
1329 | exec_failed|||
1330 | expect_number|||
1331 | fbm_compile||5.005000|
1332 | fbm_instr||5.005000|
1333 | feature_is_enabled|||
1334 | fetch_cop_label||5.011000|
1335 | filter_add|||
1336 | filter_del|||
1337 | filter_gets|||
1338 | filter_read|||
1339 | find_and_forget_pmops|||
1340 | find_array_subscript|||
1341 | find_beginning|||
1342 | find_byclass|||
1343 | find_hash_subscript|||
1344 | find_in_my_stash|||
1345 | find_runcv||5.008001|
1346 | find_rundefsvoffset||5.009002|
1347 | find_rundefsv||5.013002|
1348 | find_script|||
1349 | find_uninit_var|||
1350 | first_symbol|||n
1351 | foldEQ_latin1||5.013008|n
1352 | foldEQ_locale||5.013002|n
1353 | foldEQ_utf8_flags||5.013010|
1354 | foldEQ_utf8||5.013002|
1355 | foldEQ||5.013002|n
1356 | fold_constants|||
1357 | forbid_setid|||
1358 | force_ident|||
1359 | force_list|||
1360 | force_next|||
1361 | force_strict_version|||
1362 | force_version|||
1363 | force_word|||
1364 | forget_pmop|||
1365 | form_nocontext|||vn
1366 | form||5.004000|v
1367 | fp_dup|||
1368 | fprintf_nocontext|||vn
1369 | free_global_struct|||
1370 | free_tied_hv_pool|||
1371 | free_tmps|||
1372 | gen_constant_list|||
1373 | get_aux_mg|||
1374 | get_av|5.006000||p
1375 | get_context||5.006000|n
1376 | get_cvn_flags|5.009005||p
1377 | get_cvs|5.011000||p
1378 | get_cv|5.006000||p
1379 | get_db_sub|||
1380 | get_debug_opts|||
1381 | get_hash_seed|||
1382 | get_hv|5.006000||p
1383 | get_mstats|||
1384 | get_no_modify|||
1385 | get_num|||
1386 | get_op_descs||5.005000|
1387 | get_op_names||5.005000|
1388 | get_opargs|||
1389 | get_ppaddr||5.006000|
1390 | get_re_arg|||
1391 | get_sv|5.006000||p
1392 | get_vtbl||5.005030|
1393 | getcwd_sv||5.007002|
1394 | getenv_len|||
1395 | glob_2number|||
1396 | glob_assign_glob|||
1397 | glob_assign_ref|||
1398 | gp_dup|||
1399 | gp_free|||
1400 | gp_ref|||
1401 | grok_bin|5.007003||p
1402 | grok_bslash_c|||
1403 | grok_bslash_o|||
1404 | grok_hex|5.007003||p
1405 | grok_number|5.007002||p
1406 | grok_numeric_radix|5.007002||p
1407 | grok_oct|5.007003||p
1408 | group_end|||
1409 | gv_AVadd|||
1410 | gv_HVadd|||
1411 | gv_IOadd|||
1412 | gv_SVadd|||
1413 | gv_add_by_type||5.011000|
1414 | gv_autoload4||5.004000|
1415 | gv_check|||
1416 | gv_const_sv||5.009003|
1417 | gv_dump||5.006000|
1418 | gv_efullname3||5.004000|
1419 | gv_efullname4||5.006001|
1420 | gv_efullname|||
1421 | gv_ename|||
1422 | gv_fetchfile_flags||5.009005|
1423 | gv_fetchfile|||
1424 | gv_fetchmeth_autoload||5.007003|
1425 | gv_fetchmethod_autoload||5.004000|
1426 | gv_fetchmethod_flags||5.011000|
1427 | gv_fetchmethod|||
1428 | gv_fetchmeth|||
1429 | gv_fetchpvn_flags|5.009002||p
1430 | gv_fetchpvs|5.009004||p
1431 | gv_fetchpv|||
1432 | gv_fetchsv|5.009002||p
1433 | gv_fullname3||5.004000|
1434 | gv_fullname4||5.006001|
1435 | gv_fullname|||
1436 | gv_get_super_pkg|||
1437 | gv_handler||5.007001|
1438 | gv_init_sv|||
1439 | gv_init|||
1440 | gv_magicalize_isa|||
1441 | gv_magicalize_overload|||
1442 | gv_name_set||5.009004|
1443 | gv_stashpvn|5.004000||p
1444 | gv_stashpvs|5.009003||p
1445 | gv_stashpv|||
1446 | gv_stashsv|||
1447 | gv_try_downgrade|||
1448 | he_dup|||
1449 | hek_dup|||
1450 | hfreeentries|||
1451 | hsplit|||
1452 | hv_assert|||
1453 | hv_auxinit|||n
1454 | hv_backreferences_p|||
1455 | hv_clear_placeholders||5.009001|
1456 | hv_clear|||
1457 | hv_common_key_len||5.010000|
1458 | hv_common||5.010000|
1459 | hv_copy_hints_hv||5.009004|
1460 | hv_delayfree_ent||5.004000|
1461 | hv_delete_common|||
1462 | hv_delete_ent||5.004000|
1463 | hv_delete|||
1464 | hv_eiter_p||5.009003|
1465 | hv_eiter_set||5.009003|
1466 | hv_ename_add|||
1467 | hv_ename_delete|||
1468 | hv_exists_ent||5.004000|
1469 | hv_exists|||
1470 | hv_fetch_ent||5.004000|
1471 | hv_fetchs|5.009003||p
1472 | hv_fetch|||
1473 | hv_fill||5.013002|
1474 | hv_free_ent||5.004000|
1475 | hv_iterinit|||
1476 | hv_iterkeysv||5.004000|
1477 | hv_iterkey|||
1478 | hv_iternext_flags||5.008000|
1479 | hv_iternextsv|||
1480 | hv_iternext|||
1481 | hv_iterval|||
1482 | hv_kill_backrefs|||
1483 | hv_ksplit||5.004000|
1484 | hv_magic_check|||n
1485 | hv_magic|||
1486 | hv_name_set||5.009003|
1487 | hv_notallowed|||
1488 | hv_placeholders_get||5.009003|
1489 | hv_placeholders_p||5.009003|
1490 | hv_placeholders_set||5.009003|
1491 | hv_riter_p||5.009003|
1492 | hv_riter_set||5.009003|
1493 | hv_scalar||5.009001|
1494 | hv_store_ent||5.004000|
1495 | hv_store_flags||5.008000|
1496 | hv_stores|5.009004||p
1497 | hv_store|||
1498 | hv_undef_flags|||
1499 | hv_undef|||
1500 | ibcmp_locale||5.004000|
1501 | ibcmp_utf8||5.007003|
1502 | ibcmp|||
1503 | incline|||
1504 | incpush_if_exists|||
1505 | incpush_use_sep|||
1506 | incpush|||
1507 | ingroup|||
1508 | init_argv_symbols|||
1509 | init_dbargs|||
1510 | init_debugger|||
1511 | init_global_struct|||
1512 | init_i18nl10n||5.006000|
1513 | init_i18nl14n||5.006000|
1514 | init_ids|||
1515 | init_interp|||
1516 | init_main_stash|||
1517 | init_perllib|||
1518 | init_postdump_symbols|||
1519 | init_predump_symbols|||
1520 | init_stacks||5.005000|
1521 | init_tm||5.007002|
1522 | instr|||n
1523 | intro_my|||
1524 | intuit_method|||
1525 | intuit_more|||
1526 | invert|||
1527 | invlist_array|||
1528 | invlist_destroy|||
1529 | invlist_extend|||
1530 | invlist_intersection|||
1531 | invlist_len|||
1532 | invlist_max|||
1533 | invlist_set_array|||
1534 | invlist_set_len|||
1535 | invlist_set_max|||
1536 | invlist_trim|||
1537 | invlist_union|||
1538 | invoke_exception_hook|||
1539 | io_close|||
1540 | isALNUMC|5.006000||p
1541 | isALPHA|||
1542 | isASCII|5.006000||p
1543 | isBLANK|5.006001||p
1544 | isCNTRL|5.006000||p
1545 | isDIGIT|||
1546 | isGRAPH|5.006000||p
1547 | isGV_with_GP|5.009004||p
1548 | isLOWER|||
1549 | isOCTAL||5.013005|
1550 | isPRINT|5.004000||p
1551 | isPSXSPC|5.006001||p
1552 | isPUNCT|5.006000||p
1553 | isSPACE|||
1554 | isUPPER|||
1555 | isWORDCHAR||5.013006|
1556 | isXDIGIT|5.006000||p
1557 | is_an_int|||
1558 | is_ascii_string||5.011000|n
1559 | is_gv_magical_sv|||
1560 | is_handle_constructor|||n
1561 | is_inplace_av|||
1562 | is_list_assignment|||
1563 | is_lvalue_sub||5.007001|
1564 | is_uni_alnum_lc||5.006000|
1565 | is_uni_alnum||5.006000|
1566 | is_uni_alpha_lc||5.006000|
1567 | is_uni_alpha||5.006000|
1568 | is_uni_ascii_lc||5.006000|
1569 | is_uni_ascii||5.006000|
1570 | is_uni_cntrl_lc||5.006000|
1571 | is_uni_cntrl||5.006000|
1572 | is_uni_digit_lc||5.006000|
1573 | is_uni_digit||5.006000|
1574 | is_uni_graph_lc||5.006000|
1575 | is_uni_graph||5.006000|
1576 | is_uni_idfirst_lc||5.006000|
1577 | is_uni_idfirst||5.006000|
1578 | is_uni_lower_lc||5.006000|
1579 | is_uni_lower||5.006000|
1580 | is_uni_print_lc||5.006000|
1581 | is_uni_print||5.006000|
1582 | is_uni_punct_lc||5.006000|
1583 | is_uni_punct||5.006000|
1584 | is_uni_space_lc||5.006000|
1585 | is_uni_space||5.006000|
1586 | is_uni_upper_lc||5.006000|
1587 | is_uni_upper||5.006000|
1588 | is_uni_xdigit_lc||5.006000|
1589 | is_uni_xdigit||5.006000|
1590 | is_utf8_X_LVT|||
1591 | is_utf8_X_LV_LVT_V|||
1592 | is_utf8_X_LV|||
1593 | is_utf8_X_L|||
1594 | is_utf8_X_T|||
1595 | is_utf8_X_V|||
1596 | is_utf8_X_begin|||
1597 | is_utf8_X_extend|||
1598 | is_utf8_X_non_hangul|||
1599 | is_utf8_X_prepend|||
1600 | is_utf8_alnum||5.006000|
1601 | is_utf8_alpha||5.006000|
1602 | is_utf8_ascii||5.006000|
1603 | is_utf8_char_slow|||n
1604 | is_utf8_char||5.006000|n
1605 | is_utf8_cntrl||5.006000|
1606 | is_utf8_common|||
1607 | is_utf8_digit||5.006000|
1608 | is_utf8_graph||5.006000|
1609 | is_utf8_idcont||5.008000|
1610 | is_utf8_idfirst||5.006000|
1611 | is_utf8_lower||5.006000|
1612 | is_utf8_mark||5.006000|
1613 | is_utf8_perl_space||5.011001|
1614 | is_utf8_perl_word||5.011001|
1615 | is_utf8_posix_digit||5.011001|
1616 | is_utf8_print||5.006000|
1617 | is_utf8_punct||5.006000|
1618 | is_utf8_space||5.006000|
1619 | is_utf8_string_loclen||5.009003|n
1620 | is_utf8_string_loc||5.008001|n
1621 | is_utf8_string||5.006001|n
1622 | is_utf8_upper||5.006000|
1623 | is_utf8_xdigit||5.006000|
1624 | is_utf8_xidcont||5.013010|
1625 | is_utf8_xidfirst||5.013010|
1626 | isa_lookup|||
1627 | items|||n
1628 | ix|||n
1629 | jmaybe|||
1630 | join_exact|||
1631 | keyword_plugin_standard|||
1632 | keyword|||
1633 | leave_scope|||
1634 | lex_bufutf8||5.011002|
1635 | lex_discard_to||5.011002|
1636 | lex_grow_linestr||5.011002|
1637 | lex_next_chunk||5.011002|
1638 | lex_peek_unichar||5.011002|
1639 | lex_read_space||5.011002|
1640 | lex_read_to||5.011002|
1641 | lex_read_unichar||5.011002|
1642 | lex_start||5.009005|
1643 | lex_stuff_pvn||5.011002|
1644 | lex_stuff_pvs||5.013005|
1645 | lex_stuff_pv||5.013006|
1646 | lex_stuff_sv||5.011002|
1647 | lex_unstuff||5.011002|
1648 | listkids|||
1649 | list|||
1650 | load_module_nocontext|||vn
1651 | load_module|5.006000||pv
1652 | localize|||
1653 | looks_like_bool|||
1654 | looks_like_number|||
1655 | lop|||
1656 | mPUSHi|5.009002||p
1657 | mPUSHn|5.009002||p
1658 | mPUSHp|5.009002||p
1659 | mPUSHs|5.010001||p
1660 | mPUSHu|5.009002||p
1661 | mXPUSHi|5.009002||p
1662 | mXPUSHn|5.009002||p
1663 | mXPUSHp|5.009002||p
1664 | mXPUSHs|5.010001||p
1665 | mXPUSHu|5.009002||p
1666 | mad_free|||
1667 | madlex|||
1668 | madparse|||
1669 | magic_clear_all_env|||
1670 | magic_clearenv|||
1671 | magic_clearhints|||
1672 | magic_clearhint|||
1673 | magic_clearisa|||
1674 | magic_clearpack|||
1675 | magic_clearsig|||
1676 | magic_dump||5.006000|
1677 | magic_existspack|||
1678 | magic_freearylen_p|||
1679 | magic_freeovrld|||
1680 | magic_getarylen|||
1681 | magic_getdefelem|||
1682 | magic_getnkeys|||
1683 | magic_getpack|||
1684 | magic_getpos|||
1685 | magic_getsig|||
1686 | magic_getsubstr|||
1687 | magic_gettaint|||
1688 | magic_getuvar|||
1689 | magic_getvec|||
1690 | magic_get|||
1691 | magic_killbackrefs|||
1692 | magic_len|||
1693 | magic_methcall1|||
1694 | magic_methcall|||v
1695 | magic_methpack|||
1696 | magic_nextpack|||
1697 | magic_regdata_cnt|||
1698 | magic_regdatum_get|||
1699 | magic_regdatum_set|||
1700 | magic_scalarpack|||
1701 | magic_set_all_env|||
1702 | magic_setamagic|||
1703 | magic_setarylen|||
1704 | magic_setcollxfrm|||
1705 | magic_setdbline|||
1706 | magic_setdefelem|||
1707 | magic_setenv|||
1708 | magic_sethint|||
1709 | magic_setisa|||
1710 | magic_setmglob|||
1711 | magic_setnkeys|||
1712 | magic_setpack|||
1713 | magic_setpos|||
1714 | magic_setregexp|||
1715 | magic_setsig|||
1716 | magic_setsubstr|||
1717 | magic_settaint|||
1718 | magic_setutf8|||
1719 | magic_setuvar|||
1720 | magic_setvec|||
1721 | magic_set|||
1722 | magic_sizepack|||
1723 | magic_wipepack|||
1724 | make_matcher|||
1725 | make_trie_failtable|||
1726 | make_trie|||
1727 | malloc_good_size|||n
1728 | malloced_size|||n
1729 | malloc||5.007002|n
1730 | markstack_grow|||
1731 | matcher_matches_sv|||
1732 | measure_struct|||
1733 | memEQs|5.009005||p
1734 | memEQ|5.004000||p
1735 | memNEs|5.009005||p
1736 | memNE|5.004000||p
1737 | mem_collxfrm|||
1738 | mem_log_common|||n
1739 | mess_alloc|||
1740 | mess_nocontext|||vn
1741 | mess_sv||5.013001|
1742 | mess||5.006000|v
1743 | method_common|||
1744 | mfree||5.007002|n
1745 | mg_clear|||
1746 | mg_copy|||
1747 | mg_dup|||
1748 | mg_findext||5.013008|
1749 | mg_find|||
1750 | mg_free_type||5.013006|
1751 | mg_free|||
1752 | mg_get|||
1753 | mg_length||5.005000|
1754 | mg_localize|||
1755 | mg_magical|||
1756 | mg_set|||
1757 | mg_size||5.005000|
1758 | mini_mktime||5.007002|
1759 | missingterm|||
1760 | mode_from_discipline|||
1761 | modkids|||
1762 | mod|||
1763 | more_bodies|||
1764 | more_sv|||
1765 | moreswitches|||
1766 | mro_clean_isarev|||
1767 | mro_gather_and_rename|||
1768 | mro_get_from_name||5.010001|
1769 | mro_get_linear_isa_dfs|||
1770 | mro_get_linear_isa||5.009005|
1771 | mro_get_private_data||5.010001|
1772 | mro_isa_changed_in|||
1773 | mro_meta_dup|||
1774 | mro_meta_init|||
1775 | mro_method_changed_in||5.009005|
1776 | mro_package_moved|||
1777 | mro_register||5.010001|
1778 | mro_set_mro||5.010001|
1779 | mro_set_private_data||5.010001|
1780 | mul128|||
1781 | mulexp10|||n
1782 | munge_qwlist_to_paren_list|||
1783 | my_atof2||5.007002|
1784 | my_atof||5.006000|
1785 | my_attrs|||
1786 | my_bcopy|||n
1787 | my_betoh16|||n
1788 | my_betoh32|||n
1789 | my_betoh64|||n
1790 | my_betohi|||n
1791 | my_betohl|||n
1792 | my_betohs|||n
1793 | my_bzero|||n
1794 | my_chsize|||
1795 | my_clearenv|||
1796 | my_cxt_index|||
1797 | my_cxt_init|||
1798 | my_dirfd||5.009005|
1799 | my_exit_jump|||
1800 | my_exit|||
1801 | my_failure_exit||5.004000|
1802 | my_fflush_all||5.006000|
1803 | my_fork||5.007003|n
1804 | my_htobe16|||n
1805 | my_htobe32|||n
1806 | my_htobe64|||n
1807 | my_htobei|||n
1808 | my_htobel|||n
1809 | my_htobes|||n
1810 | my_htole16|||n
1811 | my_htole32|||n
1812 | my_htole64|||n
1813 | my_htolei|||n
1814 | my_htolel|||n
1815 | my_htoles|||n
1816 | my_htonl|||
1817 | my_kid|||
1818 | my_letoh16|||n
1819 | my_letoh32|||n
1820 | my_letoh64|||n
1821 | my_letohi|||n
1822 | my_letohl|||n
1823 | my_letohs|||n
1824 | my_lstat_flags|||
1825 | my_lstat||5.014000|
1826 | my_memcmp||5.004000|n
1827 | my_memset|||n
1828 | my_ntohl|||
1829 | my_pclose||5.004000|
1830 | my_popen_list||5.007001|
1831 | my_popen||5.004000|
1832 | my_setenv|||
1833 | my_snprintf|5.009004||pvn
1834 | my_socketpair||5.007003|n
1835 | my_sprintf|5.009003||pvn
1836 | my_stat_flags|||
1837 | my_stat||5.014000|
1838 | my_strftime||5.007002|
1839 | my_strlcat|5.009004||pn
1840 | my_strlcpy|5.009004||pn
1841 | my_swabn|||n
1842 | my_swap|||
1843 | my_unexec|||
1844 | my_vsnprintf||5.009004|n
1845 | need_utf8|||n
1846 | newANONATTRSUB||5.006000|
1847 | newANONHASH|||
1848 | newANONLIST|||
1849 | newANONSUB|||
1850 | newASSIGNOP|||
1851 | newATTRSUB||5.006000|
1852 | newAVREF|||
1853 | newAV|||
1854 | newBINOP|||
1855 | newCONDOP|||
1856 | newCONSTSUB|5.004050||p
1857 | newCVREF|||
1858 | newDEFSVOP|||
1859 | newFORM|||
1860 | newFOROP||5.013007|
1861 | newGIVENOP||5.009003|
1862 | newGIVWHENOP|||
1863 | newGP|||
1864 | newGVOP|||
1865 | newGVREF|||
1866 | newGVgen|||
1867 | newHVREF|||
1868 | newHVhv||5.005000|
1869 | newHV|||
1870 | newIO|||
1871 | newLISTOP|||
1872 | newLOGOP|||
1873 | newLOOPEX|||
1874 | newLOOPOP|||
1875 | newMADPROP|||
1876 | newMADsv|||
1877 | newMYSUB|||
1878 | newNULLLIST|||
1879 | newOP|||
1880 | newPADOP|||
1881 | newPMOP|||
1882 | newPROG|||
1883 | newPVOP|||
1884 | newRANGE|||
1885 | newRV_inc|5.004000||p
1886 | newRV_noinc|5.004000||p
1887 | newRV|||
1888 | newSLICEOP|||
1889 | newSTATEOP|||
1890 | newSUB|||
1891 | newSVOP|||
1892 | newSVREF|||
1893 | newSV_type|5.009005||p
1894 | newSVhek||5.009003|
1895 | newSViv|||
1896 | newSVnv|||
1897 | newSVpv_share||5.013006|
1898 | newSVpvf_nocontext|||vn
1899 | newSVpvf||5.004000|v
1900 | newSVpvn_flags|5.010001||p
1901 | newSVpvn_share|5.007001||p
1902 | newSVpvn_utf8|5.010001||p
1903 | newSVpvn|5.004050||p
1904 | newSVpvs_flags|5.010001||p
1905 | newSVpvs_share|5.009003||p
1906 | newSVpvs|5.009003||p
1907 | newSVpv|||
1908 | newSVrv|||
1909 | newSVsv|||
1910 | newSVuv|5.006000||p
1911 | newSV|||
1912 | newTOKEN|||
1913 | newUNOP|||
1914 | newWHENOP||5.009003|
1915 | newWHILEOP||5.013007|
1916 | newXS_flags||5.009004|
1917 | newXSproto||5.006000|
1918 | newXS||5.006000|
1919 | new_collate||5.006000|
1920 | new_constant|||
1921 | new_ctype||5.006000|
1922 | new_he|||
1923 | new_logop|||
1924 | new_numeric||5.006000|
1925 | new_stackinfo||5.005000|
1926 | new_version||5.009000|
1927 | new_warnings_bitfield|||
1928 | next_symbol|||
1929 | nextargv|||
1930 | nextchar|||
1931 | ninstr|||n
1932 | no_bareword_allowed|||
1933 | no_fh_allowed|||
1934 | no_op|||
1935 | not_a_number|||
1936 | nothreadhook||5.008000|
1937 | nuke_stacks|||
1938 | num_overflow|||n
1939 | oopsAV|||
1940 | oopsHV|||
1941 | op_append_elem||5.013006|
1942 | op_append_list||5.013006|
1943 | op_clear|||
1944 | op_const_sv|||
1945 | op_contextualize||5.013006|
1946 | op_dump||5.006000|
1947 | op_free|||
1948 | op_getmad_weak|||
1949 | op_getmad|||
1950 | op_linklist||5.013006|
1951 | op_lvalue||5.013007|
1952 | op_null||5.007002|
1953 | op_prepend_elem||5.013006|
1954 | op_refcnt_dec|||
1955 | op_refcnt_inc|||
1956 | op_refcnt_lock||5.009002|
1957 | op_refcnt_unlock||5.009002|
1958 | op_scope||5.013007|
1959 | op_xmldump|||
1960 | open_script|||
1961 | opt_scalarhv|||
1962 | pMY_CXT_|5.007003||p
1963 | pMY_CXT|5.007003||p
1964 | pTHX_|5.006000||p
1965 | pTHX|5.006000||p
1966 | packWARN|5.007003||p
1967 | pack_cat||5.007003|
1968 | pack_rec|||
1969 | package_version|||
1970 | package|||
1971 | packlist||5.008001|
1972 | pad_add_anon|||
1973 | pad_add_name_sv|||
1974 | pad_add_name|||
1975 | pad_alloc|||
1976 | pad_block_start|||
1977 | pad_check_dup|||
1978 | pad_compname_type|||
1979 | pad_findlex|||
1980 | pad_findmy||5.011002|
1981 | pad_fixup_inner_anons|||
1982 | pad_free|||
1983 | pad_leavemy|||
1984 | pad_new|||
1985 | pad_peg|||n
1986 | pad_push|||
1987 | pad_reset|||
1988 | pad_setsv|||
1989 | pad_sv|||
1990 | pad_swipe|||
1991 | pad_tidy|||
1992 | padlist_dup|||
1993 | parse_arithexpr||5.013008|
1994 | parse_barestmt||5.013007|
1995 | parse_block||5.013007|
1996 | parse_body|||
1997 | parse_fullexpr||5.013008|
1998 | parse_fullstmt||5.013005|
1999 | parse_label||5.013007|
2000 | parse_listexpr||5.013008|
2001 | parse_stmtseq||5.013006|
2002 | parse_termexpr||5.013008|
2003 | parse_unicode_opts|||
2004 | parser_dup|||
2005 | parser_free|||
2006 | path_is_absolute|||n
2007 | peep|||
2008 | pending_Slabs_to_ro|||
2009 | perl_alloc_using|||n
2010 | perl_alloc|||n
2011 | perl_clone_using|||n
2012 | perl_clone|||n
2013 | perl_construct|||n
2014 | perl_destruct||5.007003|n
2015 | perl_free|||n
2016 | perl_parse||5.006000|n
2017 | perl_run|||n
2018 | pidgone|||
2019 | pm_description|||
2020 | pmop_dump||5.006000|
2021 | pmop_xmldump|||
2022 | pmruntime|||
2023 | pmtrans|||
2024 | pop_scope|||
2025 | populate_isa|||v
2026 | pregcomp||5.009005|
2027 | pregexec|||
2028 | pregfree2||5.011000|
2029 | pregfree|||
2030 | prepend_madprops|||
2031 | prescan_version||5.011004|
2032 | printbuf|||
2033 | printf_nocontext|||vn
2034 | process_special_blocks|||
2035 | ptr_table_clear||5.009005|
2036 | ptr_table_fetch||5.009005|
2037 | ptr_table_find|||n
2038 | ptr_table_free||5.009005|
2039 | ptr_table_new||5.009005|
2040 | ptr_table_split||5.009005|
2041 | ptr_table_store||5.009005|
2042 | push_scope|||
2043 | put_byte|||
2044 | pv_display|5.006000||p
2045 | pv_escape|5.009004||p
2046 | pv_pretty|5.009004||p
2047 | pv_uni_display||5.007003|
2048 | qerror|||
2049 | qsortsvu|||
2050 | re_compile||5.009005|
2051 | re_croak2|||
2052 | re_dup_guts|||
2053 | re_intuit_start||5.009005|
2054 | re_intuit_string||5.006000|
2055 | readpipe_override|||
2056 | realloc||5.007002|n
2057 | reentrant_free|||
2058 | reentrant_init|||
2059 | reentrant_retry|||vn
2060 | reentrant_size|||
2061 | ref_array_or_hash|||
2062 | refcounted_he_chain_2hv|||
2063 | refcounted_he_fetch_pvn|||
2064 | refcounted_he_fetch_pvs|||
2065 | refcounted_he_fetch_pv|||
2066 | refcounted_he_fetch_sv|||
2067 | refcounted_he_free|||
2068 | refcounted_he_inc|||
2069 | refcounted_he_new_pvn|||
2070 | refcounted_he_new_pvs|||
2071 | refcounted_he_new_pv|||
2072 | refcounted_he_new_sv|||
2073 | refcounted_he_value|||
2074 | refkids|||
2075 | refto|||
2076 | ref||5.014000|
2077 | reg_check_named_buff_matched|||
2078 | reg_named_buff_all||5.009005|
2079 | reg_named_buff_exists||5.009005|
2080 | reg_named_buff_fetch||5.009005|
2081 | reg_named_buff_firstkey||5.009005|
2082 | reg_named_buff_iter|||
2083 | reg_named_buff_nextkey||5.009005|
2084 | reg_named_buff_scalar||5.009005|
2085 | reg_named_buff|||
2086 | reg_namedseq|||
2087 | reg_node|||
2088 | reg_numbered_buff_fetch|||
2089 | reg_numbered_buff_length|||
2090 | reg_numbered_buff_store|||
2091 | reg_qr_package|||
2092 | reg_recode|||
2093 | reg_scan_name|||
2094 | reg_skipcomment|||
2095 | reg_temp_copy|||
2096 | reganode|||
2097 | regatom|||
2098 | regbranch|||
2099 | regclass_swash||5.009004|
2100 | regclass|||
2101 | regcppop|||
2102 | regcppush|||
2103 | regcurly|||
2104 | regdump_extflags|||
2105 | regdump||5.005000|
2106 | regdupe_internal|||
2107 | regexec_flags||5.005000|
2108 | regfree_internal||5.009005|
2109 | reghop3|||n
2110 | reghop4|||n
2111 | reghopmaybe3|||n
2112 | reginclass|||
2113 | reginitcolors||5.006000|
2114 | reginsert|||
2115 | regmatch|||
2116 | regnext||5.005000|
2117 | regpiece|||
2118 | regpposixcc|||
2119 | regprop|||
2120 | regrepeat|||
2121 | regtail_study|||
2122 | regtail|||
2123 | regtry|||
2124 | reguni|||
2125 | regwhite|||n
2126 | reg|||
2127 | repeatcpy|||n
2128 | report_evil_fh|||
2129 | report_uninit|||
2130 | report_wrongway_fh|||
2131 | require_pv||5.006000|
2132 | require_tie_mod|||
2133 | restore_magic|||
2134 | rninstr|||n
2135 | rpeep|||
2136 | rsignal_restore|||
2137 | rsignal_save|||
2138 | rsignal_state||5.004000|
2139 | rsignal||5.004000|
2140 | run_body|||
2141 | run_user_filter|||
2142 | runops_debug||5.005000|
2143 | runops_standard||5.005000|
2144 | rv2cv_op_cv||5.013006|
2145 | rvpv_dup|||
2146 | rxres_free|||
2147 | rxres_restore|||
2148 | rxres_save|||
2149 | safesyscalloc||5.006000|n
2150 | safesysfree||5.006000|n
2151 | safesysmalloc||5.006000|n
2152 | safesysrealloc||5.006000|n
2153 | same_dirent|||
2154 | save_I16||5.004000|
2155 | save_I32|||
2156 | save_I8||5.006000|
2157 | save_adelete||5.011000|
2158 | save_aelem_flags||5.011000|
2159 | save_aelem||5.004050|
2160 | save_alloc||5.006000|
2161 | save_aptr|||
2162 | save_ary|||
2163 | save_bool||5.008001|
2164 | save_clearsv|||
2165 | save_delete|||
2166 | save_destructor_x||5.006000|
2167 | save_destructor||5.006000|
2168 | save_freeop|||
2169 | save_freepv|||
2170 | save_freesv|||
2171 | save_generic_pvref||5.006001|
2172 | save_generic_svref||5.005030|
2173 | save_gp||5.004000|
2174 | save_hash|||
2175 | save_hdelete||5.011000|
2176 | save_hek_flags|||n
2177 | save_helem_flags||5.011000|
2178 | save_helem||5.004050|
2179 | save_hints||5.010001|
2180 | save_hptr|||
2181 | save_int|||
2182 | save_item|||
2183 | save_iv||5.005000|
2184 | save_lines|||
2185 | save_list|||
2186 | save_long|||
2187 | save_magic|||
2188 | save_mortalizesv||5.007001|
2189 | save_nogv|||
2190 | save_op||5.005000|
2191 | save_padsv_and_mortalize||5.010001|
2192 | save_pptr|||
2193 | save_pushi32ptr||5.010001|
2194 | save_pushptri32ptr|||
2195 | save_pushptrptr||5.010001|
2196 | save_pushptr||5.010001|
2197 | save_re_context||5.006000|
2198 | save_scalar_at|||
2199 | save_scalar|||
2200 | save_set_svflags||5.009000|
2201 | save_shared_pvref||5.007003|
2202 | save_sptr|||
2203 | save_svref|||
2204 | save_vptr||5.006000|
2205 | savepvn|||
2206 | savepvs||5.009003|
2207 | savepv|||
2208 | savesharedpvn||5.009005|
2209 | savesharedpvs||5.013006|
2210 | savesharedpv||5.007003|
2211 | savesharedsvpv||5.013006|
2212 | savestack_grow_cnt||5.008001|
2213 | savestack_grow|||
2214 | savesvpv||5.009002|
2215 | sawparens|||
2216 | scalar_mod_type|||n
2217 | scalarboolean|||
2218 | scalarkids|||
2219 | scalarseq|||
2220 | scalarvoid|||
2221 | scalar|||
2222 | scan_bin||5.006000|
2223 | scan_commit|||
2224 | scan_const|||
2225 | scan_formline|||
2226 | scan_heredoc|||
2227 | scan_hex|||
2228 | scan_ident|||
2229 | scan_inputsymbol|||
2230 | scan_num||5.007001|
2231 | scan_oct|||
2232 | scan_pat|||
2233 | scan_str|||
2234 | scan_subst|||
2235 | scan_trans|||
2236 | scan_version||5.009001|
2237 | scan_vstring||5.009005|
2238 | scan_word|||
2239 | screaminstr||5.005000|
2240 | search_const|||
2241 | seed||5.008001|
2242 | sequence_num|||
2243 | sequence_tail|||
2244 | sequence|||
2245 | set_context||5.006000|n
2246 | set_numeric_local||5.006000|
2247 | set_numeric_radix||5.006000|
2248 | set_numeric_standard||5.006000|
2249 | set_regclass_bit_fold|||
2250 | set_regclass_bit|||
2251 | setdefout|||
2252 | share_hek_flags|||
2253 | share_hek||5.004000|
2254 | si_dup|||
2255 | sighandler|||n
2256 | simplify_sort|||
2257 | skipspace0|||
2258 | skipspace1|||
2259 | skipspace2|||
2260 | skipspace|||
2261 | softref2xv|||
2262 | sortcv_stacked|||
2263 | sortcv_xsub|||
2264 | sortcv|||
2265 | sortsv_flags||5.009003|
2266 | sortsv||5.007003|
2267 | space_join_names_mortal|||
2268 | ss_dup|||
2269 | stack_grow|||
2270 | start_force|||
2271 | start_glob|||
2272 | start_subparse||5.004000|
2273 | stashpv_hvname_match||5.014000|
2274 | stdize_locale|||
2275 | store_cop_label|||
2276 | strEQ|||
2277 | strGE|||
2278 | strGT|||
2279 | strLE|||
2280 | strLT|||
2281 | strNE|||
2282 | str_to_version||5.006000|
2283 | strip_return|||
2284 | strnEQ|||
2285 | strnNE|||
2286 | study_chunk|||
2287 | sub_crush_depth|||
2288 | sublex_done|||
2289 | sublex_push|||
2290 | sublex_start|||
2291 | sv_2bool_flags||5.013006|
2292 | sv_2bool|||
2293 | sv_2cv|||
2294 | sv_2io|||
2295 | sv_2iuv_common|||
2296 | sv_2iuv_non_preserve|||
2297 | sv_2iv_flags||5.009001|
2298 | sv_2iv|||
2299 | sv_2mortal|||
2300 | sv_2num|||
2301 | sv_2nv_flags||5.013001|
2302 | sv_2pv_flags|5.007002||p
2303 | sv_2pv_nolen|5.006000||p
2304 | sv_2pvbyte_nolen|5.006000||p
2305 | sv_2pvbyte|5.006000||p
2306 | sv_2pvutf8_nolen||5.006000|
2307 | sv_2pvutf8||5.006000|
2308 | sv_2pv|||
2309 | sv_2uv_flags||5.009001|
2310 | sv_2uv|5.004000||p
2311 | sv_add_arena|||
2312 | sv_add_backref|||
2313 | sv_backoff|||
2314 | sv_bless|||
2315 | sv_cat_decode||5.008001|
2316 | sv_catpv_flags||5.013006|
2317 | sv_catpv_mg|5.004050||p
2318 | sv_catpv_nomg||5.013006|
2319 | sv_catpvf_mg_nocontext|||pvn
2320 | sv_catpvf_mg|5.006000|5.004000|pv
2321 | sv_catpvf_nocontext|||vn
2322 | sv_catpvf||5.004000|v
2323 | sv_catpvn_flags||5.007002|
2324 | sv_catpvn_mg|5.004050||p
2325 | sv_catpvn_nomg|5.007002||p
2326 | sv_catpvn|||
2327 | sv_catpvs_flags||5.013006|
2328 | sv_catpvs_mg||5.013006|
2329 | sv_catpvs_nomg||5.013006|
2330 | sv_catpvs|5.009003||p
2331 | sv_catpv|||
2332 | sv_catsv_flags||5.007002|
2333 | sv_catsv_mg|5.004050||p
2334 | sv_catsv_nomg|5.007002||p
2335 | sv_catsv|||
2336 | sv_catxmlpvn|||
2337 | sv_catxmlpv|||
2338 | sv_catxmlsv|||
2339 | sv_chop|||
2340 | sv_clean_all|||
2341 | sv_clean_objs|||
2342 | sv_clear|||
2343 | sv_cmp_flags||5.013006|
2344 | sv_cmp_locale_flags||5.013006|
2345 | sv_cmp_locale||5.004000|
2346 | sv_cmp|||
2347 | sv_collxfrm_flags||5.013006|
2348 | sv_collxfrm|||
2349 | sv_compile_2op_is_broken|||
2350 | sv_compile_2op||5.008001|
2351 | sv_copypv||5.007003|
2352 | sv_dec_nomg||5.013002|
2353 | sv_dec|||
2354 | sv_del_backref|||
2355 | sv_derived_from||5.004000|
2356 | sv_destroyable||5.010000|
2357 | sv_does||5.009004|
2358 | sv_dump|||
2359 | sv_dup_common|||
2360 | sv_dup_inc_multiple|||
2361 | sv_dup_inc|||
2362 | sv_dup|||
2363 | sv_eq_flags||5.013006|
2364 | sv_eq|||
2365 | sv_exp_grow|||
2366 | sv_force_normal_flags||5.007001|
2367 | sv_force_normal||5.006000|
2368 | sv_free2|||
2369 | sv_free_arenas|||
2370 | sv_free|||
2371 | sv_gets||5.004000|
2372 | sv_grow|||
2373 | sv_i_ncmp|||
2374 | sv_inc_nomg||5.013002|
2375 | sv_inc|||
2376 | sv_insert_flags||5.010001|
2377 | sv_insert|||
2378 | sv_isa|||
2379 | sv_isobject|||
2380 | sv_iv||5.005000|
2381 | sv_kill_backrefs|||
2382 | sv_len_utf8||5.006000|
2383 | sv_len|||
2384 | sv_magic_portable|5.014000|5.004000|p
2385 | sv_magicext||5.007003|
2386 | sv_magic|||
2387 | sv_mortalcopy|||
2388 | sv_ncmp|||
2389 | sv_newmortal|||
2390 | sv_newref|||
2391 | sv_nolocking||5.007003|
2392 | sv_nosharing||5.007003|
2393 | sv_nounlocking|||
2394 | sv_nv||5.005000|
2395 | sv_peek||5.005000|
2396 | sv_pos_b2u_midway|||
2397 | sv_pos_b2u||5.006000|
2398 | sv_pos_u2b_cached|||
2399 | sv_pos_u2b_flags||5.011005|
2400 | sv_pos_u2b_forwards|||n
2401 | sv_pos_u2b_midway|||n
2402 | sv_pos_u2b||5.006000|
2403 | sv_pvbyten_force||5.006000|
2404 | sv_pvbyten||5.006000|
2405 | sv_pvbyte||5.006000|
2406 | sv_pvn_force_flags|5.007002||p
2407 | sv_pvn_force|||
2408 | sv_pvn_nomg|5.007003|5.005000|p
2409 | sv_pvn||5.005000|
2410 | sv_pvutf8n_force||5.006000|
2411 | sv_pvutf8n||5.006000|
2412 | sv_pvutf8||5.006000|
2413 | sv_pv||5.006000|
2414 | sv_recode_to_utf8||5.007003|
2415 | sv_reftype|||
2416 | sv_release_COW|||
2417 | sv_replace|||
2418 | sv_report_used|||
2419 | sv_reset|||
2420 | sv_rvweaken||5.006000|
2421 | sv_setiv_mg|5.004050||p
2422 | sv_setiv|||
2423 | sv_setnv_mg|5.006000||p
2424 | sv_setnv|||
2425 | sv_setpv_mg|5.004050||p
2426 | sv_setpvf_mg_nocontext|||pvn
2427 | sv_setpvf_mg|5.006000|5.004000|pv
2428 | sv_setpvf_nocontext|||vn
2429 | sv_setpvf||5.004000|v
2430 | sv_setpviv_mg||5.008001|
2431 | sv_setpviv||5.008001|
2432 | sv_setpvn_mg|5.004050||p
2433 | sv_setpvn|||
2434 | sv_setpvs_mg||5.013006|
2435 | sv_setpvs|5.009004||p
2436 | sv_setpv|||
2437 | sv_setref_iv|||
2438 | sv_setref_nv|||
2439 | sv_setref_pvn|||
2440 | sv_setref_pvs||5.013006|
2441 | sv_setref_pv|||
2442 | sv_setref_uv||5.007001|
2443 | sv_setsv_cow|||
2444 | sv_setsv_flags||5.007002|
2445 | sv_setsv_mg|5.004050||p
2446 | sv_setsv_nomg|5.007002||p
2447 | sv_setsv|||
2448 | sv_setuv_mg|5.004050||p
2449 | sv_setuv|5.004000||p
2450 | sv_tainted||5.004000|
2451 | sv_taint||5.004000|
2452 | sv_true||5.005000|
2453 | sv_unglob|||
2454 | sv_uni_display||5.007003|
2455 | sv_unmagicext||5.013008|
2456 | sv_unmagic|||
2457 | sv_unref_flags||5.007001|
2458 | sv_unref|||
2459 | sv_untaint||5.004000|
2460 | sv_upgrade|||
2461 | sv_usepvn_flags||5.009004|
2462 | sv_usepvn_mg|5.004050||p
2463 | sv_usepvn|||
2464 | sv_utf8_decode||5.006000|
2465 | sv_utf8_downgrade||5.006000|
2466 | sv_utf8_encode||5.006000|
2467 | sv_utf8_upgrade_flags_grow||5.011000|
2468 | sv_utf8_upgrade_flags||5.007002|
2469 | sv_utf8_upgrade_nomg||5.007002|
2470 | sv_utf8_upgrade||5.007001|
2471 | sv_uv|5.005000||p
2472 | sv_vcatpvf_mg|5.006000|5.004000|p
2473 | sv_vcatpvfn||5.004000|
2474 | sv_vcatpvf|5.006000|5.004000|p
2475 | sv_vsetpvf_mg|5.006000|5.004000|p
2476 | sv_vsetpvfn||5.004000|
2477 | sv_vsetpvf|5.006000|5.004000|p
2478 | sv_xmlpeek|||
2479 | svtype|||
2480 | swallow_bom|||
2481 | swash_fetch||5.007002|
2482 | swash_get|||
2483 | swash_init||5.006000|
2484 | sys_init3||5.010000|n
2485 | sys_init||5.010000|n
2486 | sys_intern_clear|||
2487 | sys_intern_dup|||
2488 | sys_intern_init|||
2489 | sys_term||5.010000|n
2490 | taint_env|||
2491 | taint_proper|||
2492 | tied_method|||v
2493 | tmps_grow||5.006000|
2494 | toLOWER|||
2495 | toUPPER|||
2496 | to_byte_substr|||
2497 | to_uni_fold||5.007003|
2498 | to_uni_lower_lc||5.006000|
2499 | to_uni_lower||5.007003|
2500 | to_uni_title_lc||5.006000|
2501 | to_uni_title||5.007003|
2502 | to_uni_upper_lc||5.006000|
2503 | to_uni_upper||5.007003|
2504 | to_utf8_case||5.007003|
2505 | to_utf8_fold||5.007003|
2506 | to_utf8_lower||5.007003|
2507 | to_utf8_substr|||
2508 | to_utf8_title||5.007003|
2509 | to_utf8_upper||5.007003|
2510 | token_free|||
2511 | token_getmad|||
2512 | tokenize_use|||
2513 | tokeq|||
2514 | tokereport|||
2515 | too_few_arguments|||
2516 | too_many_arguments|||
2517 | try_amagic_bin|||
2518 | try_amagic_un|||
2519 | uiv_2buf|||n
2520 | unlnk|||
2521 | unpack_rec|||
2522 | unpack_str||5.007003|
2523 | unpackstring||5.008001|
2524 | unreferenced_to_tmp_stack|||
2525 | unshare_hek_or_pvn|||
2526 | unshare_hek|||
2527 | unsharepvn||5.004000|
2528 | unwind_handler_stack|||
2529 | update_debugger_info|||
2530 | upg_version||5.009005|
2531 | usage|||
2532 | utf16_textfilter|||
2533 | utf16_to_utf8_reversed||5.006001|
2534 | utf16_to_utf8||5.006001|
2535 | utf8_distance||5.006000|
2536 | utf8_hop||5.006000|
2537 | utf8_length||5.007001|
2538 | utf8_mg_len_cache_update|||
2539 | utf8_mg_pos_cache_update|||
2540 | utf8_to_bytes||5.006001|
2541 | utf8_to_uvchr||5.007001|
2542 | utf8_to_uvuni||5.007001|
2543 | utf8n_to_uvchr|||
2544 | utf8n_to_uvuni||5.007001|
2545 | utilize|||
2546 | uvchr_to_utf8_flags||5.007003|
2547 | uvchr_to_utf8|||
2548 | uvuni_to_utf8_flags||5.007003|
2549 | uvuni_to_utf8||5.007001|
2550 | validate_suid|||
2551 | varname|||
2552 | vcmp||5.009000|
2553 | vcroak||5.006000|
2554 | vdeb||5.007003|
2555 | vform||5.006000|
2556 | visit|||
2557 | vivify_defelem|||
2558 | vivify_ref|||
2559 | vload_module|5.006000||p
2560 | vmess||5.006000|
2561 | vnewSVpvf|5.006000|5.004000|p
2562 | vnormal||5.009002|
2563 | vnumify||5.009000|
2564 | vstringify||5.009000|
2565 | vverify||5.009003|
2566 | vwarner||5.006000|
2567 | vwarn||5.006000|
2568 | wait4pid|||
2569 | warn_nocontext|||vn
2570 | warn_sv||5.013001|
2571 | warner_nocontext|||vn
2572 | warner|5.006000|5.004000|pv
2573 | warn|||v
2574 | watch|||
2575 | whichsig|||
2576 | with_queued_errors|||
2577 | write_no_mem|||
2578 | write_to_stderr|||
2579 | xmldump_all_perl|||
2580 | xmldump_all|||
2581 | xmldump_attr|||
2582 | xmldump_eval|||
2583 | xmldump_form|||
2584 | xmldump_indent|||v
2585 | xmldump_packsubs_perl|||
2586 | xmldump_packsubs|||
2587 | xmldump_sub_perl|||
2588 | xmldump_sub|||
2589 | xmldump_vindent|||
2590 | xs_apiversion_bootcheck|||
2591 | xs_version_bootcheck|||
2592 | yyerror|||
2593 | yylex|||
2594 | yyparse|||
2595 | yyunlex|||
2596 | yywarn|||
2597 | );
2598 | 
2599 | if (exists $opt{'list-unsupported'}) {
2600 |   my $f;
2601 |   for $f (sort { lc $a cmp lc $b } keys %API) {
2602 |     next unless $API{$f}{todo};
2603 |     print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2604 |   }
2605 |   exit 0;
2606 | }
2607 | 
2608 | # Scan for possible replacement candidates
2609 | 
2610 | my(%replace, %need, %hints, %warnings, %depends);
2611 | my $replace = 0;
2612 | my($hint, $define, $function);
2613 | 
2614 | sub find_api
2615 | {
2616 |   my $code = shift;
2617 |   $code =~ s{
2618 |     / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2619 |   | "[^"\\]*(?:\\.[^"\\]*)*"
2620 |   | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2621 |   grep { exists $API{$_} } $code =~ /(\w+)/mg;
2622 | }
2623 | 
2624 | while (<DATA>) {
2625 |   if ($hint) {
2626 |     my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2627 |     if (m{^\s*\*\s(.*?)\s*$}) {
2628 |       for (@{$hint->[1]}) {
2629 |         $h->{$_} ||= '';  # suppress warning with older perls
2630 |         $h->{$_} .= "$1\n";
2631 |       }
2632 |     }
2633 |     else { undef $hint }
2634 |   }
2635 | 
2636 |   $hint = [$1, [split /,?\s+/, $2]]
2637 |       if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2638 | 
2639 |   if ($define) {
2640 |     if ($define->[1] =~ /\\$/) {
2641 |       $define->[1] .= $_;
2642 |     }
2643 |     else {
2644 |       if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2645 |         my @n = find_api($define->[1]);
2646 |         push @{$depends{$define->[0]}}, @n if @n
2647 |       }
2648 |       undef $define;
2649 |     }
2650 |   }
2651 | 
2652 |   $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2653 | 
2654 |   if ($function) {
2655 |     if (/^}/) {
2656 |       if (exists $API{$function->[0]}) {
2657 |         my @n = find_api($function->[1]);
2658 |         push @{$depends{$function->[0]}}, @n if @n
2659 |       }
2660 |       undef $function;
2661 |     }
2662 |     else {
2663 |       $function->[1] .= $_;
2664 |     }
2665 |   }
2666 | 
2667 |   $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2668 | 
2669 |   $replace     = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2670 |   $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2671 |   $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2672 |   $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2673 | 
2674 |   if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2675 |     my @deps = map { s/\s+//g; $_ } split /,/, $3;
2676 |     my $d;
2677 |     for $d (map { s/\s+//g; $_ } split /,/, $1) {
2678 |       push @{$depends{$d}}, @deps;
2679 |     }
2680 |   }
2681 | 
2682 |   $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2683 | }
2684 | 
2685 | for (values %depends) {
2686 |   my %s;
2687 |   $_ = [sort grep !$s{$_}++, @$_];
2688 | }
2689 | 
2690 | if (exists $opt{'api-info'}) {
2691 |   my $f;
2692 |   my $count = 0;
2693 |   my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2694 |   for $f (sort { lc $a cmp lc $b } keys %API) {
2695 |     next unless $f =~ /$match/;
2696 |     print "\n=== $f ===\n\n";
2697 |     my $info = 0;
2698 |     if ($API{$f}{base} || $API{$f}{todo}) {
2699 |       my $base = format_version($API{$f}{base} || $API{$f}{todo});
2700 |       print "Supported at least starting from perl-$base.\n";
2701 |       $info++;
2702 |     }
2703 |     if ($API{$f}{provided}) {
2704 |       my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2705 |       print "Support by $ppport provided back to perl-$todo.\n";
2706 |       print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2707 |       print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2708 |       print "\n$hints{$f}" if exists $hints{$f};
2709 |       print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2710 |       $info++;
2711 |     }
2712 |     print "No portability information available.\n" unless $info;
2713 |     $count++;
2714 |   }
2715 |   $count or print "Found no API matching '$opt{'api-info'}'.";
2716 |   print "\n";
2717 |   exit 0;
2718 | }
2719 | 
2720 | if (exists $opt{'list-provided'}) {
2721 |   my $f;
2722 |   for $f (sort { lc $a cmp lc $b } keys %API) {
2723 |     next unless $API{$f}{provided};
2724 |     my @flags;
2725 |     push @flags, 'explicit' if exists $need{$f};
2726 |     push @flags, 'depend'   if exists $depends{$f};
2727 |     push @flags, 'hint'     if exists $hints{$f};
2728 |     push @flags, 'warning'  if exists $warnings{$f};
2729 |     my $flags = @flags ? '  ['.join(', ', @flags).']' : '';
2730 |     print "$f$flags\n";
2731 |   }
2732 |   exit 0;
2733 | }
2734 | 
2735 | my @files;
2736 | my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2737 | my $srcext = join '|', map { quotemeta $_ } @srcext;
2738 | 
2739 | if (@ARGV) {
2740 |   my %seen;
2741 |   for (@ARGV) {
2742 |     if (-e) {
2743 |       if (-f) {
2744 |         push @files, $_ unless $seen{$_}++;
2745 |       }
2746 |       else { warn "'$_' is not a file.\n" }
2747 |     }
2748 |     else {
2749 |       my @new = grep { -f } glob $_
2750 |           or warn "'$_' does not exist.\n";
2751 |       push @files, grep { !$seen{$_}++ } @new;
2752 |     }
2753 |   }
2754 | }
2755 | else {
2756 |   eval {
2757 |     require File::Find;
2758 |     File::Find::find(sub {
2759 |       $File::Find::name =~ /($srcext)$/i
2760 |           and push @files, $File::Find::name;
2761 |     }, '.');
2762 |   };
2763 |   if ($@) {
2764 |     @files = map { glob "*$_" } @srcext;
2765 |   }
2766 | }
2767 | 
2768 | if (!@ARGV || $opt{filter}) {
2769 |   my(@in, @out);
2770 |   my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2771 |   for (@files) {
2772 |     my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2773 |     push @{ $out ? \@out : \@in }, $_;
2774 |   }
2775 |   if (@ARGV && @out) {
2776 |     warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2777 |   }
2778 |   @files = @in;
2779 | }
2780 | 
2781 | die "No input files given!\n" unless @files;
2782 | 
2783 | my(%files, %global, %revreplace);
2784 | %revreplace = reverse %replace;
2785 | my $filename;
2786 | my $patch_opened = 0;
2787 | 
2788 | for $filename (@files) {
2789 |   unless (open IN, "<$filename") {
2790 |     warn "Unable to read from $filename: $!\n";
2791 |     next;
2792 |   }
2793 | 
2794 |   info("Scanning $filename ...");
2795 | 
2796 |   my $c = do { local $/; <IN> };
2797 |   close IN;
2798 | 
2799 |   my %file = (orig => $c, changes => 0);
2800 | 
2801 |   # Temporarily remove C/XS comments and strings from the code
2802 |   my @ccom;
2803 | 
2804 |   $c =~ s{
2805 |     ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
2806 |     | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
2807 |   | ( ^$HS*\#[^\r\n]*
2808 |     | "[^"\\]*(?:\\.[^"\\]*)*"
2809 |     | '[^'\\]*(?:\\.[^'\\]*)*'
2810 |     | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
2811 |   }{ defined $2 and push @ccom, $2;
2812 |      defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
2813 | 
2814 |   $file{ccom} = \@ccom;
2815 |   $file{code} = $c;
2816 |   $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
2817 | 
2818 |   my $func;
2819 | 
2820 |   for $func (keys %API) {
2821 |     my $match = $func;
2822 |     $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2823 |     if ($c =~ /\b(?:Perl_)?($match)\b/) {
2824 |       $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2825 |       $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2826 |       if (exists $API{$func}{provided}) {
2827 |         $file{uses_provided}{$func}++;
2828 |         if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2829 |           $file{uses}{$func}++;
2830 |           my @deps = rec_depend($func);
2831 |           if (@deps) {
2832 |             $file{uses_deps}{$func} = \@deps;
2833 |             for (@deps) {
2834 |               $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2835 |             }
2836 |           }
2837 |           for ($func, @deps) {
2838 |             $file{needs}{$_} = 'static' if exists $need{$_};
2839 |           }
2840 |         }
2841 |       }
2842 |       if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2843 |         if ($c =~ /\b$func\b/) {
2844 |           $file{uses_todo}{$func}++;
2845 |         }
2846 |       }
2847 |     }
2848 |   }
2849 | 
2850 |   while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2851 |     if (exists $need{$2}) {
2852 |       $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2853 |     }
2854 |     else { warning("Possibly wrong #define $1 in $filename") }
2855 |   }
2856 | 
2857 |   for (qw(uses needs uses_todo needed_global needed_static)) {
2858 |     for $func (keys %{$file{$_}}) {
2859 |       push @{$global{$_}{$func}}, $filename;
2860 |     }
2861 |   }
2862 | 
2863 |   $files{$filename} = \%file;
2864 | }
2865 | 
2866 | # Globally resolve NEED_'s
2867 | my $need;
2868 | for $need (keys %{$global{needs}}) {
2869 |   if (@{$global{needs}{$need}} > 1) {
2870 |     my @targets = @{$global{needs}{$need}};
2871 |     my @t = grep $files{$_}{needed_global}{$need}, @targets;
2872 |     @targets = @t if @t;
2873 |     @t = grep /\.xs$/i, @targets;
2874 |     @targets = @t if @t;
2875 |     my $target = shift @targets;
2876 |     $files{$target}{needs}{$need} = 'global';
2877 |     for (@{$global{needs}{$need}}) {
2878 |       $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2879 |     }
2880 |   }
2881 | }
2882 | 
2883 | for $filename (@files) {
2884 |   exists $files{$filename} or next;
2885 | 
2886 |   info("=== Analyzing $filename ===");
2887 | 
2888 |   my %file = %{$files{$filename}};
2889 |   my $func;
2890 |   my $c = $file{code};
2891 |   my $warnings = 0;
2892 | 
2893 |   for $func (sort keys %{$file{uses_Perl}}) {
2894 |     if ($API{$func}{varargs}) {
2895 |       unless ($API{$func}{nothxarg}) {
2896 |         my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2897 |                               { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2898 |         if ($changes) {
2899 |           warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2900 |           $file{changes} += $changes;
2901 |         }
2902 |       }
2903 |     }
2904 |     else {
2905 |       warning("Uses Perl_$func instead of $func");
2906 |       $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2907 |                                 {$func$1(}g);
2908 |     }
2909 |   }
2910 | 
2911 |   for $func (sort keys %{$file{uses_replace}}) {
2912 |     warning("Uses $func instead of $replace{$func}");
2913 |     $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2914 |   }
2915 | 
2916 |   for $func (sort keys %{$file{uses_provided}}) {
2917 |     if ($file{uses}{$func}) {
2918 |       if (exists $file{uses_deps}{$func}) {
2919 |         diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2920 |       }
2921 |       else {
2922 |         diag("Uses $func");
2923 |       }
2924 |     }
2925 |     $warnings += hint($func);
2926 |   }
2927 | 
2928 |   unless ($opt{quiet}) {
2929 |     for $func (sort keys %{$file{uses_todo}}) {
2930 |       print "*** WARNING: Uses $func, which may not be portable below perl ",
2931 |             format_version($API{$func}{todo}), ", even with '$ppport'\n";
2932 |       $warnings++;
2933 |     }
2934 |   }
2935 | 
2936 |   for $func (sort keys %{$file{needed_static}}) {
2937 |     my $message = '';
2938 |     if (not exists $file{uses}{$func}) {
2939 |       $message = "No need to define NEED_$func if $func is never used";
2940 |     }
2941 |     elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2942 |       $message = "No need to define NEED_$func when already needed globally";
2943 |     }
2944 |     if ($message) {
2945 |       diag($message);
2946 |       $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2947 |     }
2948 |   }
2949 | 
2950 |   for $func (sort keys %{$file{needed_global}}) {
2951 |     my $message = '';
2952 |     if (not exists $global{uses}{$func}) {
2953 |       $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2954 |     }
2955 |     elsif (exists $file{needs}{$func}) {
2956 |       if ($file{needs}{$func} eq 'extern') {
2957 |         $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2958 |       }
2959 |       elsif ($file{needs}{$func} eq 'static') {
2960 |         $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2961 |       }
2962 |     }
2963 |     if ($message) {
2964 |       diag($message);
2965 |       $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2966 |     }
2967 |   }
2968 | 
2969 |   $file{needs_inc_ppport} = keys %{$file{uses}};
2970 | 
2971 |   if ($file{needs_inc_ppport}) {
2972 |     my $pp = '';
2973 | 
2974 |     for $func (sort keys %{$file{needs}}) {
2975 |       my $type = $file{needs}{$func};
2976 |       next if $type eq 'extern';
2977 |       my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2978 |       unless (exists $file{"needed_$type"}{$func}) {
2979 |         if ($type eq 'global') {
2980 |           diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2981 |         }
2982 |         else {
2983 |           diag("File needs $func, adding static request");
2984 |         }
2985 |         $pp .= "#define NEED_$func$suffix\n";
2986 |       }
2987 |     }
2988 | 
2989 |     if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2990 |       $pp = '';
2991 |       $file{changes}++;
2992 |     }
2993 | 
2994 |     unless ($file{has_inc_ppport}) {
2995 |       diag("Needs to include '$ppport'");
2996 |       $pp .= qq(#include "$ppport"\n)
2997 |     }
2998 | 
2999 |     if ($pp) {
3000 |       $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
3001 |                      || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
3002 |                      || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
3003 |                      || ($c =~ s/^/$pp/);
3004 |     }
3005 |   }
3006 |   else {
3007 |     if ($file{has_inc_ppport}) {
3008 |       diag("No need to include '$ppport'");
3009 |       $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
3010 |     }
3011 |   }
3012 | 
3013 |   # put back in our C comments
3014 |   my $ix;
3015 |   my $cppc = 0;
3016 |   my @ccom = @{$file{ccom}};
3017 |   for $ix (0 .. $#ccom) {
3018 |     if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
3019 |       $cppc++;
3020 |       $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
3021 |     }
3022 |     else {
3023 |       $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
3024 |     }
3025 |   }
3026 | 
3027 |   if ($cppc) {
3028 |     my $s = $cppc != 1 ? 's' : '';
3029 |     warning("Uses $cppc C++ style comment$s, which is not portable");
3030 |   }
3031 | 
3032 |   my $s = $warnings != 1 ? 's' : '';
3033 |   my $warn = $warnings ? " ($warnings warning$s)" : '';
3034 |   info("Analysis completed$warn");
3035 | 
3036 |   if ($file{changes}) {
3037 |     if (exists $opt{copy}) {
3038 |       my $newfile = "$filename$opt{copy}";
3039 |       if (-e $newfile) {
3040 |         error("'$newfile' already exists, refusing to write copy of '$filename'");
3041 |       }
3042 |       else {
3043 |         local *F;
3044 |         if (open F, ">$newfile") {
3045 |           info("Writing copy of '$filename' with changes to '$newfile'");
3046 |           print F $c;
3047 |           close F;
3048 |         }
3049 |         else {
3050 |           error("Cannot open '$newfile' for writing: $!");
3051 |         }
3052 |       }
3053 |     }
3054 |     elsif (exists $opt{patch} || $opt{changes}) {
3055 |       if (exists $opt{patch}) {
3056 |         unless ($patch_opened) {
3057 |           if (open PATCH, ">$opt{patch}") {
3058 |             $patch_opened = 1;
3059 |           }
3060 |           else {
3061 |             error("Cannot open '$opt{patch}' for writing: $!");
3062 |             delete $opt{patch};
3063 |             $opt{changes} = 1;
3064 |             goto fallback;
3065 |           }
3066 |         }
3067 |         mydiff(\*PATCH, $filename, $c);
3068 |       }
3069 |       else {
3070 | fallback:
3071 |         info("Suggested changes:");
3072 |         mydiff(\*STDOUT, $filename, $c);
3073 |       }
3074 |     }
3075 |     else {
3076 |       my $s = $file{changes} == 1 ? '' : 's';
3077 |       info("$file{changes} potentially required change$s detected");
3078 |     }
3079 |   }
3080 |   else {
3081 |     info("Looks good");
3082 |   }
3083 | }
3084 | 
3085 | close PATCH if $patch_opened;
3086 | 
3087 | exit 0;
3088 | 
3089 | 
3090 | sub try_use { eval "use @_;"; return $@ eq '' }
3091 | 
3092 | sub mydiff
3093 | {
3094 |   local *F = shift;
3095 |   my($file, $str) = @_;
3096 |   my $diff;
3097 | 
3098 |   if (exists $opt{diff}) {
3099 |     $diff = run_diff($opt{diff}, $file, $str);
3100 |   }
3101 | 
3102 |   if (!defined $diff and try_use('Text::Diff')) {
3103 |     $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
3104 |     $diff = <<HEADER . $diff;
3105 | --- $file
3106 | +++ $file.patched
3107 | HEADER
3108 |   }
3109 | 
3110 |   if (!defined $diff) {
3111 |     $diff = run_diff('diff -u', $file, $str);
3112 |   }
3113 | 
3114 |   if (!defined $diff) {
3115 |     $diff = run_diff('diff', $file, $str);
3116 |   }
3117 | 
3118 |   if (!defined $diff) {
3119 |     error("Cannot generate a diff. Please install Text::Diff or use --copy.");
3120 |     return;
3121 |   }
3122 | 
3123 |   print F $diff;
3124 | }
3125 | 
3126 | sub run_diff
3127 | {
3128 |   my($prog, $file, $str) = @_;
3129 |   my $tmp = 'dppptemp';
3130 |   my $suf = 'aaa';
3131 |   my $diff = '';
3132 |   local *F;
3133 | 
3134 |   while (-e "$tmp.$suf") { $suf++ }
3135 |   $tmp = "$tmp.$suf";
3136 | 
3137 |   if (open F, ">$tmp") {
3138 |     print F $str;
3139 |     close F;
3140 | 
3141 |     if (open F, "$prog $file $tmp |") {
3142 |       while (<F>) {
3143 |         s/\Q$tmp\E/$file.patched/;
3144 |         $diff .= $_;
3145 |       }
3146 |       close F;
3147 |       unlink $tmp;
3148 |       return $diff;
3149 |     }
3150 | 
3151 |     unlink $tmp;
3152 |   }
3153 |   else {
3154 |     error("Cannot open '$tmp' for writing: $!");
3155 |   }
3156 | 
3157 |   return undef;
3158 | }
3159 | 
3160 | sub rec_depend
3161 | {
3162 |   my($func, $seen) = @_;
3163 |   return () unless exists $depends{$func};
3164 |   $seen = {%{$seen||{}}};
3165 |   return () if $seen->{$func}++;
3166 |   my %s;
3167 |   grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
3168 | }
3169 | 
3170 | sub parse_version
3171 | {
3172 |   my $ver = shift;
3173 | 
3174 |   if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3175 |     return ($1, $2, $3);
3176 |   }
3177 |   elsif ($ver !~ /^\d+\.[\d_]+$/) {
3178 |     die "cannot parse version '$ver'\n";
3179 |   }
3180 | 
3181 |   $ver =~ s/_//g;
3182 |   $ver =~ s/$/000000/;
3183 | 
3184 |   my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3185 | 
3186 |   $v = int $v;
3187 |   $s = int $s;
3188 | 
3189 |   if ($r < 5 || ($r == 5 && $v < 6)) {
3190 |     if ($s % 10) {
3191 |       die "cannot parse version '$ver'\n";
3192 |     }
3193 |   }
3194 | 
3195 |   return ($r, $v, $s);
3196 | }
3197 | 
3198 | sub format_version
3199 | {
3200 |   my $ver = shift;
3201 | 
3202 |   $ver =~ s/$/000000/;
3203 |   my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3204 | 
3205 |   $v = int $v;
3206 |   $s = int $s;
3207 | 
3208 |   if ($r < 5 || ($r == 5 && $v < 6)) {
3209 |     if ($s % 10) {
3210 |       die "invalid version '$ver'\n";
3211 |     }
3212 |     $s /= 10;
3213 | 
3214 |     $ver = sprintf "%d.%03d", $r, $v;
3215 |     $s > 0 and $ver .= sprintf "_%02d", $s;
3216 | 
3217 |     return $ver;
3218 |   }
3219 | 
3220 |   return sprintf "%d.%d.%d", $r, $v, $s;
3221 | }
3222 | 
3223 | sub info
3224 | {
3225 |   $opt{quiet} and return;
3226 |   print @_, "\n";
3227 | }
3228 | 
3229 | sub diag
3230 | {
3231 |   $opt{quiet} and return;
3232 |   $opt{diag} and print @_, "\n";
3233 | }
3234 | 
3235 | sub warning
3236 | {
3237 |   $opt{quiet} and return;
3238 |   print "*** ", @_, "\n";
3239 | }
3240 | 
3241 | sub error
3242 | {
3243 |   print "*** ERROR: ", @_, "\n";
3244 | }
3245 | 
3246 | my %given_hints;
3247 | my %given_warnings;
3248 | sub hint
3249 | {
3250 |   $opt{quiet} and return;
3251 |   my $func = shift;
3252 |   my $rv = 0;
3253 |   if (exists $warnings{$func} && !$given_warnings{$func}++) {
3254 |     my $warn = $warnings{$func};
3255 |     $warn =~ s!^!*** !mg;
3256 |     print "*** WARNING: $func\n", $warn;
3257 |     $rv++;
3258 |   }
3259 |   if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3260 |     my $hint = $hints{$func};
3261 |     $hint =~ s/^/   /mg;
3262 |     print "   --- hint for $func ---\n", $hint;
3263 |   }
3264 |   $rv;
3265 | }
3266 | 
3267 | sub usage
3268 | {
3269 |   my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3270 |   my %M = ( 'I' => '*' );
3271 |   $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3272 |   $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3273 | 
3274 |   print <<ENDUSAGE;
3275 | 
3276 | Usage: $usage
3277 | 
3278 | See perldoc $0 for details.
3279 | 
3280 | ENDUSAGE
3281 | 
3282 |   exit 2;
3283 | }
3284 | 
3285 | sub strip
3286 | {
3287 |   my $self = do { local(@ARGV,$/)=($0); <> };
3288 |   my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3289 |   $copy =~ s/^(?=\S+)/    /gms;
3290 |   $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3291 |   $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3292 | if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3293 |   eval { require Devel::PPPort };
3294 |   \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3295 |   if (eval \$Devel::PPPort::VERSION < $VERSION) {
3296 |     die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3297 |       . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3298 |       . "Please install a newer version, or --unstrip will not work.\\n";
3299 |   }
3300 |   Devel::PPPort::WriteFile(\$0);
3301 |   exit 0;
3302 | }
3303 | print <<END;
3304 | 
3305 | Sorry, but this is a stripped version of \$0.
3306 | 
3307 | To be able to use its original script and doc functionality,
3308 | please try to regenerate this file using:
3309 | 
3310 |   \$^X \$0 --unstrip
3311 | 
3312 | END
3313 | /ms;
3314 |   my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3315 |   $c =~ s{
3316 |     / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3317 |   | ( "[^"\\]*(?:\\.[^"\\]*)*"
3318 |     | '[^'\\]*(?:\\.[^'\\]*)*' )
3319 |   | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3320 |   $c =~ s!\s+$!!mg;
3321 |   $c =~ s!^$LF!!mg;
3322 |   $c =~ s!^\s*#\s*!#!mg;
3323 |   $c =~ s!^\s+!!mg;
3324 | 
3325 |   open OUT, ">$0" or die "cannot strip $0: $!\n";
3326 |   print OUT "$pl$c\n";
3327 | 
3328 |   exit 0;
3329 | }
3330 | 
3331 | __DATA__
3332 | */
3333 | 
3334 | #ifndef _P_P_PORTABILITY_H_
3335 | #define _P_P_PORTABILITY_H_
3336 | 
3337 | #ifndef DPPP_NAMESPACE
3338 | #  define DPPP_NAMESPACE DPPP_
3339 | #endif
3340 | 
3341 | #define DPPP_CAT2(x,y) CAT2(x,y)
3342 | #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3343 | 
3344 | #ifndef PERL_REVISION
3345 | #  if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3346 | #    define PERL_PATCHLEVEL_H_IMPLICIT
3347 | #    include <patchlevel.h>
3348 | #  endif
3349 | #  if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3350 | #    include <could_not_find_Perl_patchlevel.h>
3351 | #  endif
3352 | #  ifndef PERL_REVISION
3353 | #    define PERL_REVISION       (5)
3354 |      /* Replace: 1 */
3355 | #    define PERL_VERSION        PATCHLEVEL
3356 | #    define PERL_SUBVERSION     SUBVERSION
3357 |      /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3358 |      /* Replace: 0 */
3359 | #  endif
3360 | #endif
3361 | 
3362 | #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3363 | #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
3364 | 
3365 | /* It is very unlikely that anyone will try to use this with Perl 6
3366 |    (or greater), but who knows.
3367 |  */
3368 | #if PERL_REVISION != 5
3369 | #  error ppport.h only works with Perl version 5
3370 | #endif /* PERL_REVISION != 5 */
3371 | #ifndef dTHR
3372 | #  define dTHR                           dNOOP
3373 | #endif
3374 | #ifndef dTHX
3375 | #  define dTHX                           dNOOP
3376 | #endif
3377 | 
3378 | #ifndef dTHXa
3379 | #  define dTHXa(x)                       dNOOP
3380 | #endif
3381 | #ifndef pTHX
3382 | #  define pTHX                           void
3383 | #endif
3384 | 
3385 | #ifndef pTHX_
3386 | #  define pTHX_
3387 | #endif
3388 | 
3389 | #ifndef aTHX
3390 | #  define aTHX
3391 | #endif
3392 | 
3393 | #ifndef aTHX_
3394 | #  define aTHX_
3395 | #endif
3396 | 
3397 | #if (PERL_BCDVERSION < 0x5006000)
3398 | #  ifdef USE_THREADS
3399 | #    define aTHXR  thr
3400 | #    define aTHXR_ thr,
3401 | #  else
3402 | #    define aTHXR
3403 | #    define aTHXR_
3404 | #  endif
3405 | #  define dTHXR  dTHR
3406 | #else
3407 | #  define aTHXR  aTHX
3408 | #  define aTHXR_ aTHX_
3409 | #  define dTHXR  dTHX
3410 | #endif
3411 | #ifndef dTHXoa
3412 | #  define dTHXoa(x)                      dTHXa(x)
3413 | #endif
3414 | 
3415 | #ifdef I_LIMITS
3416 | #  include <limits.h>
3417 | #endif
3418 | 
3419 | #ifndef PERL_UCHAR_MIN
3420 | #  define PERL_UCHAR_MIN ((unsigned char)0)
3421 | #endif
3422 | 
3423 | #ifndef PERL_UCHAR_MAX
3424 | #  ifdef UCHAR_MAX
3425 | #    define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3426 | #  else
3427 | #    ifdef MAXUCHAR
3428 | #      define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3429 | #    else
3430 | #      define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3431 | #    endif
3432 | #  endif
3433 | #endif
3434 | 
3435 | #ifndef PERL_USHORT_MIN
3436 | #  define PERL_USHORT_MIN ((unsigned short)0)
3437 | #endif
3438 | 
3439 | #ifndef PERL_USHORT_MAX
3440 | #  ifdef USHORT_MAX
3441 | #    define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3442 | #  else
3443 | #    ifdef MAXUSHORT
3444 | #      define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3445 | #    else
3446 | #      ifdef USHRT_MAX
3447 | #        define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3448 | #      else
3449 | #        define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3450 | #      endif
3451 | #    endif
3452 | #  endif
3453 | #endif
3454 | 
3455 | #ifndef PERL_SHORT_MAX
3456 | #  ifdef SHORT_MAX
3457 | #    define PERL_SHORT_MAX ((short)SHORT_MAX)
3458 | #  else
3459 | #    ifdef MAXSHORT    /* Often used in <values.h> */
3460 | #      define PERL_SHORT_MAX ((short)MAXSHORT)
3461 | #    else
3462 | #      ifdef SHRT_MAX
3463 | #        define PERL_SHORT_MAX ((short)SHRT_MAX)
3464 | #      else
3465 | #        define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3466 | #      endif
3467 | #    endif
3468 | #  endif
3469 | #endif
3470 | 
3471 | #ifndef PERL_SHORT_MIN
3472 | #  ifdef SHORT_MIN
3473 | #    define PERL_SHORT_MIN ((short)SHORT_MIN)
3474 | #  else
3475 | #    ifdef MINSHORT
3476 | #      define PERL_SHORT_MIN ((short)MINSHORT)
3477 | #    else
3478 | #      ifdef SHRT_MIN
3479 | #        define PERL_SHORT_MIN ((short)SHRT_MIN)
3480 | #      else
3481 | #        define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3482 | #      endif
3483 | #    endif
3484 | #  endif
3485 | #endif
3486 | 
3487 | #ifndef PERL_UINT_MAX
3488 | #  ifdef UINT_MAX
3489 | #    define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3490 | #  else
3491 | #    ifdef MAXUINT
3492 | #      define PERL_UINT_MAX ((unsigned int)MAXUINT)
3493 | #    else
3494 | #      define PERL_UINT_MAX (~(unsigned int)0)
3495 | #    endif
3496 | #  endif
3497 | #endif
3498 | 
3499 | #ifndef PERL_UINT_MIN
3500 | #  define PERL_UINT_MIN ((unsigned int)0)
3501 | #endif
3502 | 
3503 | #ifndef PERL_INT_MAX
3504 | #  ifdef INT_MAX
3505 | #    define PERL_INT_MAX ((int)INT_MAX)
3506 | #  else
3507 | #    ifdef MAXINT    /* Often used in <values.h> */
3508 | #      define PERL_INT_MAX ((int)MAXINT)
3509 | #    else
3510 | #      define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3511 | #    endif
3512 | #  endif
3513 | #endif
3514 | 
3515 | #ifndef PERL_INT_MIN
3516 | #  ifdef INT_MIN
3517 | #    define PERL_INT_MIN ((int)INT_MIN)
3518 | #  else
3519 | #    ifdef MININT
3520 | #      define PERL_INT_MIN ((int)MININT)
3521 | #    else
3522 | #      define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3523 | #    endif
3524 | #  endif
3525 | #endif
3526 | 
3527 | #ifndef PERL_ULONG_MAX
3528 | #  ifdef ULONG_MAX
3529 | #    define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3530 | #  else
3531 | #    ifdef MAXULONG
3532 | #      define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3533 | #    else
3534 | #      define PERL_ULONG_MAX (~(unsigned long)0)
3535 | #    endif
3536 | #  endif
3537 | #endif
3538 | 
3539 | #ifndef PERL_ULONG_MIN
3540 | #  define PERL_ULONG_MIN ((unsigned long)0L)
3541 | #endif
3542 | 
3543 | #ifndef PERL_LONG_MAX
3544 | #  ifdef LONG_MAX
3545 | #    define PERL_LONG_MAX ((long)LONG_MAX)
3546 | #  else
3547 | #    ifdef MAXLONG
3548 | #      define PERL_LONG_MAX ((long)MAXLONG)
3549 | #    else
3550 | #      define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3551 | #    endif
3552 | #  endif
3553 | #endif
3554 | 
3555 | #ifndef PERL_LONG_MIN
3556 | #  ifdef LONG_MIN
3557 | #    define PERL_LONG_MIN ((long)LONG_MIN)
3558 | #  else
3559 | #    ifdef MINLONG
3560 | #      define PERL_LONG_MIN ((long)MINLONG)
3561 | #    else
3562 | #      define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3563 | #    endif
3564 | #  endif
3565 | #endif
3566 | 
3567 | #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3568 | #  ifndef PERL_UQUAD_MAX
3569 | #    ifdef ULONGLONG_MAX
3570 | #      define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3571 | #    else
3572 | #      ifdef MAXULONGLONG
3573 | #        define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3574 | #      else
3575 | #        define PERL_UQUAD_MAX (~(unsigned long long)0)
3576 | #      endif
3577 | #    endif
3578 | #  endif
3579 | 
3580 | #  ifndef PERL_UQUAD_MIN
3581 | #    define PERL_UQUAD_MIN ((unsigned long long)0L)
3582 | #  endif
3583 | 
3584 | #  ifndef PERL_QUAD_MAX
3585 | #    ifdef LONGLONG_MAX
3586 | #      define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3587 | #    else
3588 | #      ifdef MAXLONGLONG
3589 | #        define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3590 | #      else
3591 | #        define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3592 | #      endif
3593 | #    endif
3594 | #  endif
3595 | 
3596 | #  ifndef PERL_QUAD_MIN
3597 | #    ifdef LONGLONG_MIN
3598 | #      define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3599 | #    else
3600 | #      ifdef MINLONGLONG
3601 | #        define PERL_QUAD_MIN ((long long)MINLONGLONG)
3602 | #      else
3603 | #        define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3604 | #      endif
3605 | #    endif
3606 | #  endif
3607 | #endif
3608 | 
3609 | /* This is based on code from 5.003 perl.h */
3610 | #ifdef HAS_QUAD
3611 | #  ifdef cray
3612 | #ifndef IVTYPE
3613 | #  define IVTYPE                         int
3614 | #endif
3615 | 
3616 | #ifndef IV_MIN
3617 | #  define IV_MIN                         PERL_INT_MIN
3618 | #endif
3619 | 
3620 | #ifndef IV_MAX
3621 | #  define IV_MAX                         PERL_INT_MAX
3622 | #endif
3623 | 
3624 | #ifndef UV_MIN
3625 | #  define UV_MIN                         PERL_UINT_MIN
3626 | #endif
3627 | 
3628 | #ifndef UV_MAX
3629 | #  define UV_MAX                         PERL_UINT_MAX
3630 | #endif
3631 | 
3632 | #    ifdef INTSIZE
3633 | #ifndef IVSIZE
3634 | #  define IVSIZE                         INTSIZE
3635 | #endif
3636 | 
3637 | #    endif
3638 | #  else
3639 | #    if defined(convex) || defined(uts)
3640 | #ifndef IVTYPE
3641 | #  define IVTYPE                         long long
3642 | #endif
3643 | 
3644 | #ifndef IV_MIN
3645 | #  define IV_MIN                         PERL_QUAD_MIN
3646 | #endif
3647 | 
3648 | #ifndef IV_MAX
3649 | #  define IV_MAX                         PERL_QUAD_MAX
3650 | #endif
3651 | 
3652 | #ifndef UV_MIN
3653 | #  define UV_MIN                         PERL_UQUAD_MIN
3654 | #endif
3655 | 
3656 | #ifndef UV_MAX
3657 | #  define UV_MAX                         PERL_UQUAD_MAX
3658 | #endif
3659 | 
3660 | #      ifdef LONGLONGSIZE
3661 | #ifndef IVSIZE
3662 | #  define IVSIZE                         LONGLONGSIZE
3663 | #endif
3664 | 
3665 | #      endif
3666 | #    else
3667 | #ifndef IVTYPE
3668 | #  define IVTYPE                         long
3669 | #endif
3670 | 
3671 | #ifndef IV_MIN
3672 | #  define IV_MIN                         PERL_LONG_MIN
3673 | #endif
3674 | 
3675 | #ifndef IV_MAX
3676 | #  define IV_MAX                         PERL_LONG_MAX
3677 | #endif
3678 | 
3679 | #ifndef UV_MIN
3680 | #  define UV_MIN                         PERL_ULONG_MIN
3681 | #endif
3682 | 
3683 | #ifndef UV_MAX
3684 | #  define UV_MAX                         PERL_ULONG_MAX
3685 | #endif
3686 | 
3687 | #      ifdef LONGSIZE
3688 | #ifndef IVSIZE
3689 | #  define IVSIZE                         LONGSIZE
3690 | #endif
3691 | 
3692 | #      endif
3693 | #    endif
3694 | #  endif
3695 | #ifndef IVSIZE
3696 | #  define IVSIZE                         8
3697 | #endif
3698 | 
3699 | #ifndef PERL_QUAD_MIN
3700 | #  define PERL_QUAD_MIN                  IV_MIN
3701 | #endif
3702 | 
3703 | #ifndef PERL_QUAD_MAX
3704 | #  define PERL_QUAD_MAX                  IV_MAX
3705 | #endif
3706 | 
3707 | #ifndef PERL_UQUAD_MIN
3708 | #  define PERL_UQUAD_MIN                 UV_MIN
3709 | #endif
3710 | 
3711 | #ifndef PERL_UQUAD_MAX
3712 | #  define PERL_UQUAD_MAX                 UV_MAX
3713 | #endif
3714 | 
3715 | #else
3716 | #ifndef IVTYPE
3717 | #  define IVTYPE                         long
3718 | #endif
3719 | 
3720 | #ifndef IV_MIN
3721 | #  define IV_MIN                         PERL_LONG_MIN
3722 | #endif
3723 | 
3724 | #ifndef IV_MAX
3725 | #  define IV_MAX                         PERL_LONG_MAX
3726 | #endif
3727 | 
3728 | #ifndef UV_MIN
3729 | #  define UV_MIN                         PERL_ULONG_MIN
3730 | #endif
3731 | 
3732 | #ifndef UV_MAX
3733 | #  define UV_MAX                         PERL_ULONG_MAX
3734 | #endif
3735 | 
3736 | #endif
3737 | 
3738 | #ifndef IVSIZE
3739 | #  ifdef LONGSIZE
3740 | #    define IVSIZE LONGSIZE
3741 | #  else
3742 | #    define IVSIZE 4 /* A bold guess, but the best we can make. */
3743 | #  endif
3744 | #endif
3745 | #ifndef UVTYPE
3746 | #  define UVTYPE                         unsigned IVTYPE
3747 | #endif
3748 | 
3749 | #ifndef UVSIZE
3750 | #  define UVSIZE                         IVSIZE
3751 | #endif
3752 | #ifndef sv_setuv
3753 | #  define sv_setuv(sv, uv)               \
3754 |                STMT_START {                         \
3755 |                  UV TeMpUv = uv;                    \
3756 |                  if (TeMpUv <= IV_MAX)              \
3757 |                    sv_setiv(sv, TeMpUv);            \
3758 |                  else                               \
3759 |                    sv_setnv(sv, (double)TeMpUv);    \
3760 |                } STMT_END
3761 | #endif
3762 | #ifndef newSVuv
3763 | #  define newSVuv(uv)                    ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3764 | #endif
3765 | #ifndef sv_2uv
3766 | #  define sv_2uv(sv)                     ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3767 | #endif
3768 | 
3769 | #ifndef SvUVX
3770 | #  define SvUVX(sv)                      ((UV)SvIVX(sv))
3771 | #endif
3772 | 
3773 | #ifndef SvUVXx
3774 | #  define SvUVXx(sv)                     SvUVX(sv)
3775 | #endif
3776 | 
3777 | #ifndef SvUV
3778 | #  define SvUV(sv)                       (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3779 | #endif
3780 | 
3781 | #ifndef SvUVx
3782 | #  define SvUVx(sv)                      ((PL_Sv = (sv)), SvUV(PL_Sv))
3783 | #endif
3784 | 
3785 | /* Hint: sv_uv
3786 |  * Always use the SvUVx() macro instead of sv_uv().
3787 |  */
3788 | #ifndef sv_uv
3789 | #  define sv_uv(sv)                      SvUVx(sv)
3790 | #endif
3791 | 
3792 | #if !defined(SvUOK) && defined(SvIOK_UV)
3793 | #  define SvUOK(sv) SvIOK_UV(sv)
3794 | #endif
3795 | #ifndef XST_mUV
3796 | #  define XST_mUV(i,v)                   (ST(i) = sv_2mortal(newSVuv(v))  )
3797 | #endif
3798 | 
3799 | #ifndef XSRETURN_UV
3800 | #  define XSRETURN_UV(v)                 STMT_START { XST_mUV(0,v);  XSRETURN(1); } STMT_END
3801 | #endif
3802 | #ifndef PUSHu
3803 | #  define PUSHu(u)                       STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG;  } STMT_END
3804 | #endif
3805 | 
3806 | #ifndef XPUSHu
3807 | #  define XPUSHu(u)                      STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
3808 | #endif
3809 | 
3810 | #ifdef HAS_MEMCMP
3811 | #ifndef memNE
3812 | #  define memNE(s1,s2,l)                 (memcmp(s1,s2,l))
3813 | #endif
3814 | 
3815 | #ifndef memEQ
3816 | #  define memEQ(s1,s2,l)                 (!memcmp(s1,s2,l))
3817 | #endif
3818 | 
3819 | #else
3820 | #ifndef memNE
3821 | #  define memNE(s1,s2,l)                 (bcmp(s1,s2,l))
3822 | #endif
3823 | 
3824 | #ifndef memEQ
3825 | #  define memEQ(s1,s2,l)                 (!bcmp(s1,s2,l))
3826 | #endif
3827 | 
3828 | #endif
3829 | #ifndef memEQs
3830 | #  define memEQs(s1, l, s2)              \
3831 |                    (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
3832 | #endif
3833 | 
3834 | #ifndef memNEs
3835 | #  define memNEs(s1, l, s2)              !memEQs(s1, l, s2)
3836 | #endif
3837 | #ifndef MoveD
3838 | #  define MoveD(s,d,n,t)                 memmove((char*)(d),(char*)(s), (n) * sizeof(t))
3839 | #endif
3840 | 
3841 | #ifndef CopyD
3842 | #  define CopyD(s,d,n,t)                 memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
3843 | #endif
3844 | 
3845 | #ifdef HAS_MEMSET
3846 | #ifndef ZeroD
3847 | #  define ZeroD(d,n,t)                   memzero((char*)(d), (n) * sizeof(t))
3848 | #endif
3849 | 
3850 | #else
3851 | #ifndef ZeroD
3852 | #  define ZeroD(d,n,t)                   ((void)memzero((char*)(d), (n) * sizeof(t)), d)
3853 | #endif
3854 | 
3855 | #endif
3856 | #ifndef PoisonWith
3857 | #  define PoisonWith(d,n,t,b)            (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
3858 | #endif
3859 | 
3860 | #ifndef PoisonNew
3861 | #  define PoisonNew(d,n,t)               PoisonWith(d,n,t,0xAB)
3862 | #endif
3863 | 
3864 | #ifndef PoisonFree
3865 | #  define PoisonFree(d,n,t)              PoisonWith(d,n,t,0xEF)
3866 | #endif
3867 | 
3868 | #ifndef Poison
3869 | #  define Poison(d,n,t)                  PoisonFree(d,n,t)
3870 | #endif
3871 | #ifndef Newx
3872 | #  define Newx(v,n,t)                    New(0,v,n,t)
3873 | #endif
3874 | 
3875 | #ifndef Newxc
3876 | #  define Newxc(v,n,t,c)                 Newc(0,v,n,t,c)
3877 | #endif
3878 | 
3879 | #ifndef Newxz
3880 | #  define Newxz(v,n,t)                   Newz(0,v,n,t)
3881 | #endif
3882 | 
3883 | #ifndef PERL_UNUSED_DECL
3884 | #  ifdef HASATTRIBUTE
3885 | #    if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3886 | #      define PERL_UNUSED_DECL
3887 | #    else
3888 | #      define PERL_UNUSED_DECL __attribute__((unused))
3889 | #    endif
3890 | #  else
3891 | #    define PERL_UNUSED_DECL
3892 | #  endif
3893 | #endif
3894 | 
3895 | #ifndef PERL_UNUSED_ARG
3896 | #  if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
3897 | #    include <note.h>
3898 | #    define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
3899 | #  else
3900 | #    define PERL_UNUSED_ARG(x) ((void)x)
3901 | #  endif
3902 | #endif
3903 | 
3904 | #ifndef PERL_UNUSED_VAR
3905 | #  define PERL_UNUSED_VAR(x) ((void)x)
3906 | #endif
3907 | 
3908 | #ifndef PERL_UNUSED_CONTEXT
3909 | #  ifdef USE_ITHREADS
3910 | #    define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
3911 | #  else
3912 | #    define PERL_UNUSED_CONTEXT
3913 | #  endif
3914 | #endif
3915 | #ifndef NOOP
3916 | #  define NOOP                           /*EMPTY*/(void)0
3917 | #endif
3918 | 
3919 | #ifndef dNOOP
3920 | #  define dNOOP                          extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
3921 | #endif
3922 | 
3923 | #ifndef NVTYPE
3924 | #  if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3925 | #    define NVTYPE long double
3926 | #  else
3927 | #    define NVTYPE double
3928 | #  endif
3929 | typedef NVTYPE NV;
3930 | #endif
3931 | 
3932 | #ifndef INT2PTR
3933 | #  if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3934 | #    define PTRV                  UV
3935 | #    define INT2PTR(any,d)        (any)(d)
3936 | #  else
3937 | #    if PTRSIZE == LONGSIZE
3938 | #      define PTRV                unsigned long
3939 | #    else
3940 | #      define PTRV                unsigned
3941 | #    endif
3942 | #    define INT2PTR(any,d)        (any)(PTRV)(d)
3943 | #  endif
3944 | #endif
3945 | 
3946 | #ifndef PTR2ul
3947 | #  if PTRSIZE == LONGSIZE
3948 | #    define PTR2ul(p)     (unsigned long)(p)
3949 | #  else
3950 | #    define PTR2ul(p)     INT2PTR(unsigned long,p)
3951 | #  endif
3952 | #endif
3953 | #ifndef PTR2nat
3954 | #  define PTR2nat(p)                     (PTRV)(p)
3955 | #endif
3956 | 
3957 | #ifndef NUM2PTR
3958 | #  define NUM2PTR(any,d)                 (any)PTR2nat(d)
3959 | #endif
3960 | 
3961 | #ifndef PTR2IV
3962 | #  define PTR2IV(p)                      INT2PTR(IV,p)
3963 | #endif
3964 | 
3965 | #ifndef PTR2UV
3966 | #  define PTR2UV(p)                      INT2PTR(UV,p)
3967 | #endif
3968 | 
3969 | #ifndef PTR2NV
3970 | #  define PTR2NV(p)                      NUM2PTR(NV,p)
3971 | #endif
3972 | 
3973 | #undef START_EXTERN_C
3974 | #undef END_EXTERN_C
3975 | #undef EXTERN_C
3976 | #ifdef __cplusplus
3977 | #  define START_EXTERN_C extern "C" {
3978 | #  define END_EXTERN_C }
3979 | #  define EXTERN_C extern "C"
3980 | #else
3981 | #  define START_EXTERN_C
3982 | #  define END_EXTERN_C
3983 | #  define EXTERN_C extern
3984 | #endif
3985 | 
3986 | #if defined(PERL_GCC_PEDANTIC)
3987 | #  ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3988 | #    define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3989 | #  endif
3990 | #endif
3991 | 
3992 | #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3993 | #  ifndef PERL_USE_GCC_BRACE_GROUPS
3994 | #    define PERL_USE_GCC_BRACE_GROUPS
3995 | #  endif
3996 | #endif
3997 | 
3998 | #undef STMT_START
3999 | #undef STMT_END
4000 | #ifdef PERL_USE_GCC_BRACE_GROUPS
4001 | #  define STMT_START	(void)(	/* gcc supports ``({ STATEMENTS; })'' */
4002 | #  define STMT_END	)
4003 | #else
4004 | #  if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
4005 | #    define STMT_START	if (1)
4006 | #    define STMT_END	else (void)0
4007 | #  else
4008 | #    define STMT_START	do
4009 | #    define STMT_END	while (0)
4010 | #  endif
4011 | #endif
4012 | #ifndef boolSV
4013 | #  define boolSV(b)                      ((b) ? &PL_sv_yes : &PL_sv_no)
4014 | #endif
4015 | 
4016 | /* DEFSV appears first in 5.004_56 */
4017 | #ifndef DEFSV
4018 | #  define DEFSV                          GvSV(PL_defgv)
4019 | #endif
4020 | 
4021 | #ifndef SAVE_DEFSV
4022 | #  define SAVE_DEFSV                     SAVESPTR(GvSV(PL_defgv))
4023 | #endif
4024 | 
4025 | #ifndef DEFSV_set
4026 | #  define DEFSV_set(sv)                  (DEFSV = (sv))
4027 | #endif
4028 | 
4029 | /* Older perls (<=5.003) lack AvFILLp */
4030 | #ifndef AvFILLp
4031 | #  define AvFILLp                        AvFILL
4032 | #endif
4033 | #ifndef ERRSV
4034 | #  define ERRSV                          get_sv("@",FALSE)
4035 | #endif
4036 | 
4037 | /* Hint: gv_stashpvn
4038 |  * This function's backport doesn't support the length parameter, but
4039 |  * rather ignores it. Portability can only be ensured if the length
4040 |  * parameter is used for speed reasons, but the length can always be
4041 |  * correctly computed from the string argument.
4042 |  */
4043 | #ifndef gv_stashpvn
4044 | #  define gv_stashpvn(str,len,create)    gv_stashpv(str,create)
4045 | #endif
4046 | 
4047 | /* Replace: 1 */
4048 | #ifndef get_cv
4049 | #  define get_cv                         perl_get_cv
4050 | #endif
4051 | 
4052 | #ifndef get_sv
4053 | #  define get_sv                         perl_get_sv
4054 | #endif
4055 | 
4056 | #ifndef get_av
4057 | #  define get_av                         perl_get_av
4058 | #endif
4059 | 
4060 | #ifndef get_hv
4061 | #  define get_hv                         perl_get_hv
4062 | #endif
4063 | 
4064 | /* Replace: 0 */
4065 | #ifndef dUNDERBAR
4066 | #  define dUNDERBAR                      dNOOP
4067 | #endif
4068 | 
4069 | #ifndef UNDERBAR
4070 | #  define UNDERBAR                       DEFSV
4071 | #endif
4072 | #ifndef dAX
4073 | #  define dAX                            I32 ax = MARK - PL_stack_base + 1
4074 | #endif
4075 | 
4076 | #ifndef dITEMS
4077 | #  define dITEMS                         I32 items = SP - MARK
4078 | #endif
4079 | #ifndef dXSTARG
4080 | #  define dXSTARG                        SV * targ = sv_newmortal()
4081 | #endif
4082 | #ifndef dAXMARK
4083 | #  define dAXMARK                        I32 ax = POPMARK; \
4084 |                                register SV ** const mark = PL_stack_base + ax++
4085 | #endif
4086 | #ifndef XSprePUSH
4087 | #  define XSprePUSH                      (sp = PL_stack_base + ax - 1)
4088 | #endif
4089 | 
4090 | #if (PERL_BCDVERSION < 0x5005000)
4091 | #  undef XSRETURN
4092 | #  define XSRETURN(off)                                   \
4093 |       STMT_START {                                        \
4094 |           PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
4095 |           return;                                         \
4096 |       } STMT_END
4097 | #endif
4098 | #ifndef XSPROTO
4099 | #  define XSPROTO(name)                  void name(pTHX_ CV* cv)
4100 | #endif
4101 | 
4102 | #ifndef SVfARG
4103 | #  define SVfARG(p)                      ((void*)(p))
4104 | #endif
4105 | #ifndef PERL_ABS
4106 | #  define PERL_ABS(x)                    ((x) < 0 ? -(x) : (x))
4107 | #endif
4108 | #ifndef dVAR
4109 | #  define dVAR                           dNOOP
4110 | #endif
4111 | #ifndef SVf
4112 | #  define SVf                            "_"
4113 | #endif
4114 | #ifndef UTF8_MAXBYTES
4115 | #  define UTF8_MAXBYTES                  UTF8_MAXLEN
4116 | #endif
4117 | #ifndef CPERLscope
4118 | #  define CPERLscope(x)                  x
4119 | #endif
4120 | #ifndef PERL_HASH
4121 | #  define PERL_HASH(hash,str,len)        \
4122 |      STMT_START	{ \
4123 | 	const char *s_PeRlHaSh = str; \
4124 | 	I32 i_PeRlHaSh = len; \
4125 | 	U32 hash_PeRlHaSh = 0; \
4126 | 	while (i_PeRlHaSh--) \
4127 | 	    hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
4128 | 	(hash) = hash_PeRlHaSh; \
4129 |     } STMT_END
4130 | #endif
4131 | 
4132 | #ifndef PERLIO_FUNCS_DECL
4133 | # ifdef PERLIO_FUNCS_CONST
4134 | #  define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
4135 | #  define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
4136 | # else
4137 | #  define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
4138 | #  define PERLIO_FUNCS_CAST(funcs) (funcs)
4139 | # endif
4140 | #endif
4141 | 
4142 | /* provide these typedefs for older perls */
4143 | #if (PERL_BCDVERSION < 0x5009003)
4144 | 
4145 | # ifdef ARGSproto
4146 | typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
4147 | # else
4148 | typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
4149 | # endif
4150 | 
4151 | typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
4152 | 
4153 | #endif
4154 | #ifndef isPSXSPC
4155 | #  define isPSXSPC(c)                    (isSPACE(c) || (c) == '\v')
4156 | #endif
4157 | 
4158 | #ifndef isBLANK
4159 | #  define isBLANK(c)                     ((c) == ' ' || (c) == '\t')
4160 | #endif
4161 | 
4162 | #ifdef EBCDIC
4163 | #ifndef isALNUMC
4164 | #  define isALNUMC(c)                    isalnum(c)
4165 | #endif
4166 | 
4167 | #ifndef isASCII
4168 | #  define isASCII(c)                     isascii(c)
4169 | #endif
4170 | 
4171 | #ifndef isCNTRL
4172 | #  define isCNTRL(c)                     iscntrl(c)
4173 | #endif
4174 | 
4175 | #ifndef isGRAPH
4176 | #  define isGRAPH(c)                     isgraph(c)
4177 | #endif
4178 | 
4179 | #ifndef isPRINT
4180 | #  define isPRINT(c)                     isprint(c)
4181 | #endif
4182 | 
4183 | #ifndef isPUNCT
4184 | #  define isPUNCT(c)                     ispunct(c)
4185 | #endif
4186 | 
4187 | #ifndef isXDIGIT
4188 | #  define isXDIGIT(c)                    isxdigit(c)
4189 | #endif
4190 | 
4191 | #else
4192 | # if (PERL_BCDVERSION < 0x5010000)
4193 | /* Hint: isPRINT
4194 |  * The implementation in older perl versions includes all of the
4195 |  * isSPACE() characters, which is wrong. The version provided by
4196 |  * Devel::PPPort always overrides a present buggy version.
4197 |  */
4198 | #  undef isPRINT
4199 | # endif
4200 | #ifndef isALNUMC
4201 | #  define isALNUMC(c)                    (isALPHA(c) || isDIGIT(c))
4202 | #endif
4203 | 
4204 | #ifndef isASCII
4205 | #  define isASCII(c)                     ((U8) (c) <= 127)
4206 | #endif
4207 | 
4208 | #ifndef isCNTRL
4209 | #  define isCNTRL(c)                     ((U8) (c) < ' ' || (c) == 127)
4210 | #endif
4211 | 
4212 | #ifndef isGRAPH
4213 | #  define isGRAPH(c)                     (isALNUM(c) || isPUNCT(c))
4214 | #endif
4215 | 
4216 | #ifndef isPRINT
4217 | #  define isPRINT(c)                     (((c) >= 32 && (c) < 127))
4218 | #endif
4219 | 
4220 | #ifndef isPUNCT
4221 | #  define isPUNCT(c)                     (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64)  || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
4222 | #endif
4223 | 
4224 | #ifndef isXDIGIT
4225 | #  define isXDIGIT(c)                    (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
4226 | #endif
4227 | 
4228 | #endif
4229 | 
4230 | #ifndef PERL_SIGNALS_UNSAFE_FLAG
4231 | 
4232 | #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4233 | 
4234 | #if (PERL_BCDVERSION < 0x5008000)
4235 | #  define D_PPP_PERL_SIGNALS_INIT   PERL_SIGNALS_UNSAFE_FLAG
4236 | #else
4237 | #  define D_PPP_PERL_SIGNALS_INIT   0
4238 | #endif
4239 | 
4240 | #if defined(NEED_PL_signals)
4241 | static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
4242 | #elif defined(NEED_PL_signals_GLOBAL)
4243 | U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
4244 | #else
4245 | extern U32 DPPP_(my_PL_signals);
4246 | #endif
4247 | #define PL_signals DPPP_(my_PL_signals)
4248 | 
4249 | #endif
4250 | 
4251 | /* Hint: PL_ppaddr
4252 |  * Calling an op via PL_ppaddr requires passing a context argument
4253 |  * for threaded builds. Since the context argument is different for
4254 |  * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
4255 |  * automatically be defined as the correct argument.
4256 |  */
4257 | 
4258 | #if (PERL_BCDVERSION <= 0x5005005)
4259 | /* Replace: 1 */
4260 | #  define PL_ppaddr                 ppaddr
4261 | #  define PL_no_modify              no_modify
4262 | /* Replace: 0 */
4263 | #endif
4264 | 
4265 | #if (PERL_BCDVERSION <= 0x5004005)
4266 | /* Replace: 1 */
4267 | #  define PL_DBsignal               DBsignal
4268 | #  define PL_DBsingle               DBsingle
4269 | #  define PL_DBsub                  DBsub
4270 | #  define PL_DBtrace                DBtrace
4271 | #  define PL_Sv                     Sv
4272 | #  define PL_bufend                 bufend
4273 | #  define PL_bufptr                 bufptr
4274 | #  define PL_compiling              compiling
4275 | #  define PL_copline                copline
4276 | #  define PL_curcop                 curcop
4277 | #  define PL_curstash               curstash
4278 | #  define PL_debstash               debstash
4279 | #  define PL_defgv                  defgv
4280 | #  define PL_diehook                diehook
4281 | #  define PL_dirty                  dirty
4282 | #  define PL_dowarn                 dowarn
4283 | #  define PL_errgv                  errgv
4284 | #  define PL_error_count            error_count
4285 | #  define PL_expect                 expect
4286 | #  define PL_hexdigit               hexdigit
4287 | #  define PL_hints                  hints
4288 | #  define PL_in_my                  in_my
4289 | #  define PL_laststatval            laststatval
4290 | #  define PL_lex_state              lex_state
4291 | #  define PL_lex_stuff              lex_stuff
4292 | #  define PL_linestr                linestr
4293 | #  define PL_na                     na
4294 | #  define PL_perl_destruct_level    perl_destruct_level
4295 | #  define PL_perldb                 perldb
4296 | #  define PL_rsfp_filters           rsfp_filters
4297 | #  define PL_rsfp                   rsfp
4298 | #  define PL_stack_base             stack_base
4299 | #  define PL_stack_sp               stack_sp
4300 | #  define PL_statcache              statcache
4301 | #  define PL_stdingv                stdingv
4302 | #  define PL_sv_arenaroot           sv_arenaroot
4303 | #  define PL_sv_no                  sv_no
4304 | #  define PL_sv_undef               sv_undef
4305 | #  define PL_sv_yes                 sv_yes
4306 | #  define PL_tainted                tainted
4307 | #  define PL_tainting               tainting
4308 | #  define PL_tokenbuf               tokenbuf
4309 | /* Replace: 0 */
4310 | #endif
4311 | 
4312 | /* Warning: PL_parser
4313 |  * For perl versions earlier than 5.9.5, this is an always
4314 |  * non-NULL dummy. Also, it cannot be dereferenced. Don't
4315 |  * use it if you can avoid is and unless you absolutely know
4316 |  * what you're doing.
4317 |  * If you always check that PL_parser is non-NULL, you can
4318 |  * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
4319 |  * a dummy parser structure.
4320 |  */
4321 | 
4322 | #if (PERL_BCDVERSION >= 0x5009005)
4323 | # ifdef DPPP_PL_parser_NO_DUMMY
4324 | #  define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4325 |                 (croak("panic: PL_parser == NULL in %s:%d", \
4326 |                        __FILE__, __LINE__), (yy_parser *) NULL))->var)
4327 | # else
4328 | #  ifdef DPPP_PL_parser_NO_DUMMY_WARNING
4329 | #   define D_PPP_parser_dummy_warning(var)
4330 | #  else
4331 | #   define D_PPP_parser_dummy_warning(var) \
4332 |              warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
4333 | #  endif
4334 | #  define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4335 |                 (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
4336 | #if defined(NEED_PL_parser)
4337 | static yy_parser DPPP_(dummy_PL_parser);
4338 | #elif defined(NEED_PL_parser_GLOBAL)
4339 | yy_parser DPPP_(dummy_PL_parser);
4340 | #else
4341 | extern yy_parser DPPP_(dummy_PL_parser);
4342 | #endif
4343 | 
4344 | # endif
4345 | 
4346 | /* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
4347 | /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
4348 |  * Do not use this variable unless you know exactly what you're
4349 |  * doint. It is internal to the perl parser and may change or even
4350 |  * be removed in the future. As of perl 5.9.5, you have to check
4351 |  * for (PL_parser != NULL) for this variable to have any effect.
4352 |  * An always non-NULL PL_parser dummy is provided for earlier
4353 |  * perl versions.
4354 |  * If PL_parser is NULL when you try to access this variable, a
4355 |  * dummy is being accessed instead and a warning is issued unless
4356 |  * you define DPPP_PL_parser_NO_DUMMY_WARNING.
4357 |  * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
4358 |  * this variable will croak with a panic message.
4359 |  */
4360 | 
4361 | # define PL_expect         D_PPP_my_PL_parser_var(expect)
4362 | # define PL_copline        D_PPP_my_PL_parser_var(copline)
4363 | # define PL_rsfp           D_PPP_my_PL_parser_var(rsfp)
4364 | # define PL_rsfp_filters   D_PPP_my_PL_parser_var(rsfp_filters)
4365 | # define PL_linestr        D_PPP_my_PL_parser_var(linestr)
4366 | # define PL_bufptr         D_PPP_my_PL_parser_var(bufptr)
4367 | # define PL_bufend         D_PPP_my_PL_parser_var(bufend)
4368 | # define PL_lex_state      D_PPP_my_PL_parser_var(lex_state)
4369 | # define PL_lex_stuff      D_PPP_my_PL_parser_var(lex_stuff)
4370 | # define PL_tokenbuf       D_PPP_my_PL_parser_var(tokenbuf)
4371 | # define PL_in_my          D_PPP_my_PL_parser_var(in_my)
4372 | # define PL_in_my_stash    D_PPP_my_PL_parser_var(in_my_stash)
4373 | # define PL_error_count    D_PPP_my_PL_parser_var(error_count)
4374 | 
4375 | 
4376 | #else
4377 | 
4378 | /* ensure that PL_parser != NULL and cannot be dereferenced */
4379 | # define PL_parser         ((void *) 1)
4380 | 
4381 | #endif
4382 | #ifndef mPUSHs
4383 | #  define mPUSHs(s)                      PUSHs(sv_2mortal(s))
4384 | #endif
4385 | 
4386 | #ifndef PUSHmortal
4387 | #  define PUSHmortal                     PUSHs(sv_newmortal())
4388 | #endif
4389 | 
4390 | #ifndef mPUSHp
4391 | #  define mPUSHp(p,l)                    sv_setpvn(PUSHmortal, (p), (l))
4392 | #endif
4393 | 
4394 | #ifndef mPUSHn
4395 | #  define mPUSHn(n)                      sv_setnv(PUSHmortal, (NV)(n))
4396 | #endif
4397 | 
4398 | #ifndef mPUSHi
4399 | #  define mPUSHi(i)                      sv_setiv(PUSHmortal, (IV)(i))
4400 | #endif
4401 | 
4402 | #ifndef mPUSHu
4403 | #  define mPUSHu(u)                      sv_setuv(PUSHmortal, (UV)(u))
4404 | #endif
4405 | #ifndef mXPUSHs
4406 | #  define mXPUSHs(s)                     XPUSHs(sv_2mortal(s))
4407 | #endif
4408 | 
4409 | #ifndef XPUSHmortal
4410 | #  define XPUSHmortal                    XPUSHs(sv_newmortal())
4411 | #endif
4412 | 
4413 | #ifndef mXPUSHp
4414 | #  define mXPUSHp(p,l)                   STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
4415 | #endif
4416 | 
4417 | #ifndef mXPUSHn
4418 | #  define mXPUSHn(n)                     STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
4419 | #endif
4420 | 
4421 | #ifndef mXPUSHi
4422 | #  define mXPUSHi(i)                     STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
4423 | #endif
4424 | 
4425 | #ifndef mXPUSHu
4426 | #  define mXPUSHu(u)                     STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
4427 | #endif
4428 | 
4429 | /* Replace: 1 */
4430 | #ifndef call_sv
4431 | #  define call_sv                        perl_call_sv
4432 | #endif
4433 | 
4434 | #ifndef call_pv
4435 | #  define call_pv                        perl_call_pv
4436 | #endif
4437 | 
4438 | #ifndef call_argv
4439 | #  define call_argv                      perl_call_argv
4440 | #endif
4441 | 
4442 | #ifndef call_method
4443 | #  define call_method                    perl_call_method
4444 | #endif
4445 | #ifndef eval_sv
4446 | #  define eval_sv                        perl_eval_sv
4447 | #endif
4448 | 
4449 | /* Replace: 0 */
4450 | #ifndef PERL_LOADMOD_DENY
4451 | #  define PERL_LOADMOD_DENY              0x1
4452 | #endif
4453 | 
4454 | #ifndef PERL_LOADMOD_NOIMPORT
4455 | #  define PERL_LOADMOD_NOIMPORT          0x2
4456 | #endif
4457 | 
4458 | #ifndef PERL_LOADMOD_IMPORT_OPS
4459 | #  define PERL_LOADMOD_IMPORT_OPS        0x4
4460 | #endif
4461 | 
4462 | #ifndef G_METHOD
4463 | # define G_METHOD		64
4464 | # ifdef call_sv
4465 | #  undef call_sv
4466 | # endif
4467 | # if (PERL_BCDVERSION < 0x5006000)
4468 | #  define call_sv(sv, flags)  ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
4469 | 				(flags) & ~G_METHOD) : perl_call_sv(sv, flags))
4470 | # else
4471 | #  define call_sv(sv, flags)  ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
4472 | 				(flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
4473 | # endif
4474 | #endif
4475 | 
4476 | /* Replace perl_eval_pv with eval_pv */
4477 | 
4478 | #ifndef eval_pv
4479 | #if defined(NEED_eval_pv)
4480 | static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4481 | static
4482 | #else
4483 | extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4484 | #endif
4485 | 
4486 | #ifdef eval_pv
4487 | #  undef eval_pv
4488 | #endif
4489 | #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4490 | #define Perl_eval_pv DPPP_(my_eval_pv)
4491 | 
4492 | #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4493 | 
4494 | SV*
4495 | DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
4496 | {
4497 |     dSP;
4498 |     SV* sv = newSVpv(p, 0);
4499 | 
4500 |     PUSHMARK(sp);
4501 |     eval_sv(sv, G_SCALAR);
4502 |     SvREFCNT_dec(sv);
4503 | 
4504 |     SPAGAIN;
4505 |     sv = POPs;
4506 |     PUTBACK;
4507 | 
4508 |     if (croak_on_error && SvTRUE(GvSV(errgv)))
4509 | 	croak(SvPVx(GvSV(errgv), na));
4510 | 
4511 |     return sv;
4512 | }
4513 | 
4514 | #endif
4515 | #endif
4516 | 
4517 | #ifndef vload_module
4518 | #if defined(NEED_vload_module)
4519 | static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4520 | static
4521 | #else
4522 | extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4523 | #endif
4524 | 
4525 | #ifdef vload_module
4526 | #  undef vload_module
4527 | #endif
4528 | #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
4529 | #define Perl_vload_module DPPP_(my_vload_module)
4530 | 
4531 | #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
4532 | 
4533 | void
4534 | DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
4535 | {
4536 |     dTHR;
4537 |     dVAR;
4538 |     OP *veop, *imop;
4539 | 
4540 |     OP * const modname = newSVOP(OP_CONST, 0, name);
4541 |     /* 5.005 has a somewhat hacky force_normal that doesn't croak on
4542 |        SvREADONLY() if PL_compling is true. Current perls take care in
4543 |        ck_require() to correctly turn off SvREADONLY before calling
4544 |        force_normal_flags(). This seems a better fix than fudging PL_compling
4545 |      */
4546 |     SvREADONLY_off(((SVOP*)modname)->op_sv);
4547 |     modname->op_private |= OPpCONST_BARE;
4548 |     if (ver) {
4549 | 	veop = newSVOP(OP_CONST, 0, ver);
4550 |     }
4551 |     else
4552 | 	veop = NULL;
4553 |     if (flags & PERL_LOADMOD_NOIMPORT) {
4554 | 	imop = sawparens(newNULLLIST());
4555 |     }
4556 |     else if (flags & PERL_LOADMOD_IMPORT_OPS) {
4557 | 	imop = va_arg(*args, OP*);
4558 |     }
4559 |     else {
4560 | 	SV *sv;
4561 | 	imop = NULL;
4562 | 	sv = va_arg(*args, SV*);
4563 | 	while (sv) {
4564 | 	    imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
4565 | 	    sv = va_arg(*args, SV*);
4566 | 	}
4567 |     }
4568 |     {
4569 | 	const line_t ocopline = PL_copline;
4570 | 	COP * const ocurcop = PL_curcop;
4571 | 	const int oexpect = PL_expect;
4572 | 
4573 | #if (PERL_BCDVERSION >= 0x5004000)
4574 | 	utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
4575 | 		veop, modname, imop);
4576 | #else
4577 | 	utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
4578 | 		modname, imop);
4579 | #endif
4580 | 	PL_expect = oexpect;
4581 | 	PL_copline = ocopline;
4582 | 	PL_curcop = ocurcop;
4583 |     }
4584 | }
4585 | 
4586 | #endif
4587 | #endif
4588 | 
4589 | #ifndef load_module
4590 | #if defined(NEED_load_module)
4591 | static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4592 | static
4593 | #else
4594 | extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4595 | #endif
4596 | 
4597 | #ifdef load_module
4598 | #  undef load_module
4599 | #endif
4600 | #define load_module DPPP_(my_load_module)
4601 | #define Perl_load_module DPPP_(my_load_module)
4602 | 
4603 | #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
4604 | 
4605 | void
4606 | DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
4607 | {
4608 |     va_list args;
4609 |     va_start(args, ver);
4610 |     vload_module(flags, name, ver, &args);
4611 |     va_end(args);
4612 | }
4613 | 
4614 | #endif
4615 | #endif
4616 | #ifndef newRV_inc
4617 | #  define newRV_inc(sv)                  newRV(sv)   /* Replace */
4618 | #endif
4619 | 
4620 | #ifndef newRV_noinc
4621 | #if defined(NEED_newRV_noinc)
4622 | static SV * DPPP_(my_newRV_noinc)(SV *sv);
4623 | static
4624 | #else
4625 | extern SV * DPPP_(my_newRV_noinc)(SV *sv);
4626 | #endif
4627 | 
4628 | #ifdef newRV_noinc
4629 | #  undef newRV_noinc
4630 | #endif
4631 | #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4632 | #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4633 | 
4634 | #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4635 | SV *
4636 | DPPP_(my_newRV_noinc)(SV *sv)
4637 | {
4638 |   SV *rv = (SV *)newRV(sv);
4639 |   SvREFCNT_dec(sv);
4640 |   return rv;
4641 | }
4642 | #endif
4643 | #endif
4644 | 
4645 | /* Hint: newCONSTSUB
4646 |  * Returns a CV* as of perl-5.7.1. This return value is not supported
4647 |  * by Devel::PPPort.
4648 |  */
4649 | 
4650 | /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4651 | #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
4652 | #if defined(NEED_newCONSTSUB)
4653 | static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
4654 | static
4655 | #else
4656 | extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
4657 | #endif
4658 | 
4659 | #ifdef newCONSTSUB
4660 | #  undef newCONSTSUB
4661 | #endif
4662 | #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4663 | #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4664 | 
4665 | #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4666 | 
4667 | /* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
4668 | /* (There's no PL_parser in perl < 5.005, so this is completely safe)     */
4669 | #define D_PPP_PL_copline PL_copline
4670 | 
4671 | void
4672 | DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
4673 | {
4674 | 	U32 oldhints = PL_hints;
4675 | 	HV *old_cop_stash = PL_curcop->cop_stash;
4676 | 	HV *old_curstash = PL_curstash;
4677 | 	line_t oldline = PL_curcop->cop_line;
4678 | 	PL_curcop->cop_line = D_PPP_PL_copline;
4679 | 
4680 | 	PL_hints &= ~HINT_BLOCK_SCOPE;
4681 | 	if (stash)
4682 | 		PL_curstash = PL_curcop->cop_stash = stash;
4683 | 
4684 | 	newSUB(
4685 | 
4686 | #if   (PERL_BCDVERSION < 0x5003022)
4687 | 		start_subparse(),
4688 | #elif (PERL_BCDVERSION == 0x5003022)
4689 |      		start_subparse(0),
4690 | #else  /* 5.003_23  onwards */
4691 |      		start_subparse(FALSE, 0),
4692 | #endif
4693 | 
4694 | 		newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
4695 | 		newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
4696 | 		newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
4697 | 	);
4698 | 
4699 | 	PL_hints = oldhints;
4700 | 	PL_curcop->cop_stash = old_cop_stash;
4701 | 	PL_curstash = old_curstash;
4702 | 	PL_curcop->cop_line = oldline;
4703 | }
4704 | #endif
4705 | #endif
4706 | 
4707 | /*
4708 |  * Boilerplate macros for initializing and accessing interpreter-local
4709 |  * data from C.  All statics in extensions should be reworked to use
4710 |  * this, if you want to make the extension thread-safe.  See ext/re/re.xs
4711 |  * for an example of the use of these macros.
4712 |  *
4713 |  * Code that uses these macros is responsible for the following:
4714 |  * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
4715 |  * 2. Declare a typedef named my_cxt_t that is a structure that contains
4716 |  *    all the data that needs to be interpreter-local.
4717 |  * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4718 |  * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4719 |  *    (typically put in the BOOT: section).
4720 |  * 5. Use the members of the my_cxt_t structure everywhere as
4721 |  *    MY_CXT.member.
4722 |  * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4723 |  *    access MY_CXT.
4724 |  */
4725 | 
4726 | #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
4727 |     defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
4728 | 
4729 | #ifndef START_MY_CXT
4730 | 
4731 | /* This must appear in all extensions that define a my_cxt_t structure,
4732 |  * right after the definition (i.e. at file scope).  The non-threads
4733 |  * case below uses it to declare the data as static. */
4734 | #define START_MY_CXT
4735 | 
4736 | #if (PERL_BCDVERSION < 0x5004068)
4737 | /* Fetches the SV that keeps the per-interpreter data. */
4738 | #define dMY_CXT_SV \
4739 | 	SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
4740 | #else /* >= perl5.004_68 */
4741 | #define dMY_CXT_SV \
4742 | 	SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,		\
4743 | 				  sizeof(MY_CXT_KEY)-1, TRUE)
4744 | #endif /* < perl5.004_68 */
4745 | 
4746 | /* This declaration should be used within all functions that use the
4747 |  * interpreter-local data. */
4748 | #define dMY_CXT	\
4749 | 	dMY_CXT_SV;							\
4750 | 	my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
4751 | 
4752 | /* Creates and zeroes the per-interpreter data.
4753 |  * (We allocate my_cxtp in a Perl SV so that it will be released when
4754 |  * the interpreter goes away.) */
4755 | #define MY_CXT_INIT \
4756 | 	dMY_CXT_SV;							\
4757 | 	/* newSV() allocates one more than needed */			\
4758 | 	my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4759 | 	Zero(my_cxtp, 1, my_cxt_t);					\
4760 | 	sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4761 | 
4762 | /* This macro must be used to access members of the my_cxt_t structure.
4763 |  * e.g. MYCXT.some_data */
4764 | #define MY_CXT		(*my_cxtp)
4765 | 
4766 | /* Judicious use of these macros can reduce the number of times dMY_CXT
4767 |  * is used.  Use is similar to pTHX, aTHX etc. */
4768 | #define pMY_CXT		my_cxt_t *my_cxtp
4769 | #define pMY_CXT_	pMY_CXT,
4770 | #define _pMY_CXT	,pMY_CXT
4771 | #define aMY_CXT		my_cxtp
4772 | #define aMY_CXT_	aMY_CXT,
4773 | #define _aMY_CXT	,aMY_CXT
4774 | 
4775 | #endif /* START_MY_CXT */
4776 | 
4777 | #ifndef MY_CXT_CLONE
4778 | /* Clones the per-interpreter data. */
4779 | #define MY_CXT_CLONE \
4780 | 	dMY_CXT_SV;							\
4781 | 	my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4782 | 	Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4783 | 	sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4784 | #endif
4785 | 
4786 | #else /* single interpreter */
4787 | 
4788 | #ifndef START_MY_CXT
4789 | 
4790 | #define START_MY_CXT	static my_cxt_t my_cxt;
4791 | #define dMY_CXT_SV	dNOOP
4792 | #define dMY_CXT		dNOOP
4793 | #define MY_CXT_INIT	NOOP
4794 | #define MY_CXT		my_cxt
4795 | 
4796 | #define pMY_CXT		void
4797 | #define pMY_CXT_
4798 | #define _pMY_CXT
4799 | #define aMY_CXT
4800 | #define aMY_CXT_
4801 | #define _aMY_CXT
4802 | 
4803 | #endif /* START_MY_CXT */
4804 | 
4805 | #ifndef MY_CXT_CLONE
4806 | #define MY_CXT_CLONE	NOOP
4807 | #endif
4808 | 
4809 | #endif
4810 | 
4811 | #ifndef IVdf
4812 | #  if IVSIZE == LONGSIZE
4813 | #    define	IVdf      "ld"
4814 | #    define	UVuf      "lu"
4815 | #    define	UVof      "lo"
4816 | #    define	UVxf      "lx"
4817 | #    define	UVXf      "lX"
4818 | #  else
4819 | #    if IVSIZE == INTSIZE
4820 | #      define	IVdf      "d"
4821 | #      define	UVuf      "u"
4822 | #      define	UVof      "o"
4823 | #      define	UVxf      "x"
4824 | #      define	UVXf      "X"
4825 | #    endif
4826 | #  endif
4827 | #endif
4828 | 
4829 | #ifndef NVef
4830 | #  if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
4831 |       defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
4832 |             /* Not very likely, but let's try anyway. */
4833 | #    define NVef          PERL_PRIeldbl
4834 | #    define NVff          PERL_PRIfldbl
4835 | #    define NVgf          PERL_PRIgldbl
4836 | #  else
4837 | #    define NVef          "e"
4838 | #    define NVff          "f"
4839 | #    define NVgf          "g"
4840 | #  endif
4841 | #endif
4842 | 
4843 | #ifndef SvREFCNT_inc
4844 | #  ifdef PERL_USE_GCC_BRACE_GROUPS
4845 | #    define SvREFCNT_inc(sv)		\
4846 |       ({				\
4847 |           SV * const _sv = (SV*)(sv);	\
4848 |           if (_sv)			\
4849 |                (SvREFCNT(_sv))++;	\
4850 |           _sv;				\
4851 |       })
4852 | #  else
4853 | #    define SvREFCNT_inc(sv)	\
4854 |           ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
4855 | #  endif
4856 | #endif
4857 | 
4858 | #ifndef SvREFCNT_inc_simple
4859 | #  ifdef PERL_USE_GCC_BRACE_GROUPS
4860 | #    define SvREFCNT_inc_simple(sv)	\
4861 |       ({					\
4862 |           if (sv)				\
4863 |                (SvREFCNT(sv))++;		\
4864 |           (SV *)(sv);				\
4865 |       })
4866 | #  else
4867 | #    define SvREFCNT_inc_simple(sv) \
4868 |           ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
4869 | #  endif
4870 | #endif
4871 | 
4872 | #ifndef SvREFCNT_inc_NN
4873 | #  ifdef PERL_USE_GCC_BRACE_GROUPS
4874 | #    define SvREFCNT_inc_NN(sv)		\
4875 |       ({					\
4876 |           SV * const _sv = (SV*)(sv);	\
4877 |           SvREFCNT(_sv)++;		\
4878 |           _sv;				\
4879 |       })
4880 | #  else
4881 | #    define SvREFCNT_inc_NN(sv) \
4882 |           (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
4883 | #  endif
4884 | #endif
4885 | 
4886 | #ifndef SvREFCNT_inc_void
4887 | #  ifdef PERL_USE_GCC_BRACE_GROUPS
4888 | #    define SvREFCNT_inc_void(sv)		\
4889 |       ({					\
4890 |           SV * const _sv = (SV*)(sv);	\
4891 |           if (_sv)			\
4892 |               (void)(SvREFCNT(_sv)++);	\
4893 |       })
4894 | #  else
4895 | #    define SvREFCNT_inc_void(sv) \
4896 |           (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
4897 | #  endif
4898 | #endif
4899 | #ifndef SvREFCNT_inc_simple_void
4900 | #  define SvREFCNT_inc_simple_void(sv)   STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
4901 | #endif
4902 | 
4903 | #ifndef SvREFCNT_inc_simple_NN
4904 | #  define SvREFCNT_inc_simple_NN(sv)     (++SvREFCNT(sv), (SV*)(sv))
4905 | #endif
4906 | 
4907 | #ifndef SvREFCNT_inc_void_NN
4908 | #  define SvREFCNT_inc_void_NN(sv)       (void)(++SvREFCNT((SV*)(sv)))
4909 | #endif
4910 | 
4911 | #ifndef SvREFCNT_inc_simple_void_NN
4912 | #  define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4913 | #endif
4914 | 
4915 | #ifndef newSV_type
4916 | 
4917 | #if defined(NEED_newSV_type)
4918 | static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
4919 | static
4920 | #else
4921 | extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
4922 | #endif
4923 | 
4924 | #ifdef newSV_type
4925 | #  undef newSV_type
4926 | #endif
4927 | #define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
4928 | #define Perl_newSV_type DPPP_(my_newSV_type)
4929 | 
4930 | #if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
4931 | 
4932 | SV*
4933 | DPPP_(my_newSV_type)(pTHX_ svtype const t)
4934 | {
4935 |   SV* const sv = newSV(0);
4936 |   sv_upgrade(sv, t);
4937 |   return sv;
4938 | }
4939 | 
4940 | #endif
4941 | 
4942 | #endif
4943 | 
4944 | #if (PERL_BCDVERSION < 0x5006000)
4945 | # define D_PPP_CONSTPV_ARG(x)  ((char *) (x))
4946 | #else
4947 | # define D_PPP_CONSTPV_ARG(x)  (x)
4948 | #endif
4949 | #ifndef newSVpvn
4950 | #  define newSVpvn(data,len)             ((data)                                              \
4951 |                                     ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
4952 |                                     : newSV(0))
4953 | #endif
4954 | #ifndef newSVpvn_utf8
4955 | #  define newSVpvn_utf8(s, len, u)       newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
4956 | #endif
4957 | #ifndef SVf_UTF8
4958 | #  define SVf_UTF8                       0
4959 | #endif
4960 | 
4961 | #ifndef newSVpvn_flags
4962 | 
4963 | #if defined(NEED_newSVpvn_flags)
4964 | static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
4965 | static
4966 | #else
4967 | extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
4968 | #endif
4969 | 
4970 | #ifdef newSVpvn_flags
4971 | #  undef newSVpvn_flags
4972 | #endif
4973 | #define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
4974 | #define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
4975 | 
4976 | #if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
4977 | 
4978 | SV *
4979 | DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
4980 | {
4981 |   SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
4982 |   SvFLAGS(sv) |= (flags & SVf_UTF8);
4983 |   return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
4984 | }
4985 | 
4986 | #endif
4987 | 
4988 | #endif
4989 | 
4990 | /* Backwards compatibility stuff... :-( */
4991 | #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
4992 | #  define NEED_sv_2pv_flags
4993 | #endif
4994 | #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
4995 | #  define NEED_sv_2pv_flags_GLOBAL
4996 | #endif
4997 | 
4998 | /* Hint: sv_2pv_nolen
4999 |  * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
5000 |  */
5001 | #ifndef sv_2pv_nolen
5002 | #  define sv_2pv_nolen(sv)               SvPV_nolen(sv)
5003 | #endif
5004 | 
5005 | #ifdef SvPVbyte
5006 | 
5007 | /* Hint: SvPVbyte
5008 |  * Does not work in perl-5.6.1, ppport.h implements a version
5009 |  * borrowed from perl-5.7.3.
5010 |  */
5011 | 
5012 | #if (PERL_BCDVERSION < 0x5007000)
5013 | 
5014 | #if defined(NEED_sv_2pvbyte)
5015 | static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
5016 | static
5017 | #else
5018 | extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
5019 | #endif
5020 | 
5021 | #ifdef sv_2pvbyte
5022 | #  undef sv_2pvbyte
5023 | #endif
5024 | #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
5025 | #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
5026 | 
5027 | #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
5028 | 
5029 | char *
5030 | DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
5031 | {
5032 |   sv_utf8_downgrade(sv,0);
5033 |   return SvPV(sv,*lp);
5034 | }
5035 | 
5036 | #endif
5037 | 
5038 | /* Hint: sv_2pvbyte
5039 |  * Use the SvPVbyte() macro instead of sv_2pvbyte().
5040 |  */
5041 | 
5042 | #undef SvPVbyte
5043 | 
5044 | #define SvPVbyte(sv, lp)                                                \
5045 |         ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK)                \
5046 |          ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
5047 | 
5048 | #endif
5049 | 
5050 | #else
5051 | 
5052 | #  define SvPVbyte          SvPV
5053 | #  define sv_2pvbyte        sv_2pv
5054 | 
5055 | #endif
5056 | #ifndef sv_2pvbyte_nolen
5057 | #  define sv_2pvbyte_nolen(sv)           sv_2pv_nolen(sv)
5058 | #endif
5059 | 
5060 | /* Hint: sv_pvn
5061 |  * Always use the SvPV() macro instead of sv_pvn().
5062 |  */
5063 | 
5064 | /* Hint: sv_pvn_force
5065 |  * Always use the SvPV_force() macro instead of sv_pvn_force().
5066 |  */
5067 | 
5068 | /* If these are undefined, they're not handled by the core anyway */
5069 | #ifndef SV_IMMEDIATE_UNREF
5070 | #  define SV_IMMEDIATE_UNREF             0
5071 | #endif
5072 | 
5073 | #ifndef SV_GMAGIC
5074 | #  define SV_GMAGIC                      0
5075 | #endif
5076 | 
5077 | #ifndef SV_COW_DROP_PV
5078 | #  define SV_COW_DROP_PV                 0
5079 | #endif
5080 | 
5081 | #ifndef SV_UTF8_NO_ENCODING
5082 | #  define SV_UTF8_NO_ENCODING            0
5083 | #endif
5084 | 
5085 | #ifndef SV_NOSTEAL
5086 | #  define SV_NOSTEAL                     0
5087 | #endif
5088 | 
5089 | #ifndef SV_CONST_RETURN
5090 | #  define SV_CONST_RETURN                0
5091 | #endif
5092 | 
5093 | #ifndef SV_MUTABLE_RETURN
5094 | #  define SV_MUTABLE_RETURN              0
5095 | #endif
5096 | 
5097 | #ifndef SV_SMAGIC
5098 | #  define SV_SMAGIC                      0
5099 | #endif
5100 | 
5101 | #ifndef SV_HAS_TRAILING_NUL
5102 | #  define SV_HAS_TRAILING_NUL            0
5103 | #endif
5104 | 
5105 | #ifndef SV_COW_SHARED_HASH_KEYS
5106 | #  define SV_COW_SHARED_HASH_KEYS        0
5107 | #endif
5108 | 
5109 | #if (PERL_BCDVERSION < 0x5007002)
5110 | 
5111 | #if defined(NEED_sv_2pv_flags)
5112 | static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5113 | static
5114 | #else
5115 | extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5116 | #endif
5117 | 
5118 | #ifdef sv_2pv_flags
5119 | #  undef sv_2pv_flags
5120 | #endif
5121 | #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
5122 | #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
5123 | 
5124 | #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
5125 | 
5126 | char *
5127 | DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
5128 | {
5129 |   STRLEN n_a = (STRLEN) flags;
5130 |   return sv_2pv(sv, lp ? lp : &n_a);
5131 | }
5132 | 
5133 | #endif
5134 | 
5135 | #if defined(NEED_sv_pvn_force_flags)
5136 | static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5137 | static
5138 | #else
5139 | extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
5140 | #endif
5141 | 
5142 | #ifdef sv_pvn_force_flags
5143 | #  undef sv_pvn_force_flags
5144 | #endif
5145 | #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
5146 | #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
5147 | 
5148 | #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
5149 | 
5150 | char *
5151 | DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
5152 | {
5153 |   STRLEN n_a = (STRLEN) flags;
5154 |   return sv_pvn_force(sv, lp ? lp : &n_a);
5155 | }
5156 | 
5157 | #endif
5158 | 
5159 | #endif
5160 | 
5161 | #if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
5162 | # define DPPP_SVPV_NOLEN_LP_ARG &PL_na
5163 | #else
5164 | # define DPPP_SVPV_NOLEN_LP_ARG 0
5165 | #endif
5166 | #ifndef SvPV_const
5167 | #  define SvPV_const(sv, lp)             SvPV_flags_const(sv, lp, SV_GMAGIC)
5168 | #endif
5169 | 
5170 | #ifndef SvPV_mutable
5171 | #  define SvPV_mutable(sv, lp)           SvPV_flags_mutable(sv, lp, SV_GMAGIC)
5172 | #endif
5173 | #ifndef SvPV_flags
5174 | #  define SvPV_flags(sv, lp, flags)      \
5175 |                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5176 |                   ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
5177 | #endif
5178 | #ifndef SvPV_flags_const
5179 | #  define SvPV_flags_const(sv, lp, flags) \
5180 |                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5181 |                   ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
5182 |                   (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
5183 | #endif
5184 | #ifndef SvPV_flags_const_nolen
5185 | #  define SvPV_flags_const_nolen(sv, flags) \
5186 |                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5187 |                   ? SvPVX_const(sv) : \
5188 |                   (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
5189 | #endif
5190 | #ifndef SvPV_flags_mutable
5191 | #  define SvPV_flags_mutable(sv, lp, flags) \
5192 |                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5193 |                   ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
5194 |                   sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5195 | #endif
5196 | #ifndef SvPV_force
5197 | #  define SvPV_force(sv, lp)             SvPV_force_flags(sv, lp, SV_GMAGIC)
5198 | #endif
5199 | 
5200 | #ifndef SvPV_force_nolen
5201 | #  define SvPV_force_nolen(sv)           SvPV_force_flags_nolen(sv, SV_GMAGIC)
5202 | #endif
5203 | 
5204 | #ifndef SvPV_force_mutable
5205 | #  define SvPV_force_mutable(sv, lp)     SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
5206 | #endif
5207 | 
5208 | #ifndef SvPV_force_nomg
5209 | #  define SvPV_force_nomg(sv, lp)        SvPV_force_flags(sv, lp, 0)
5210 | #endif
5211 | 
5212 | #ifndef SvPV_force_nomg_nolen
5213 | #  define SvPV_force_nomg_nolen(sv)      SvPV_force_flags_nolen(sv, 0)
5214 | #endif
5215 | #ifndef SvPV_force_flags
5216 | #  define SvPV_force_flags(sv, lp, flags) \
5217 |                  ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5218 |                  ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
5219 | #endif
5220 | #ifndef SvPV_force_flags_nolen
5221 | #  define SvPV_force_flags_nolen(sv, flags) \
5222 |                  ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5223 |                  ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
5224 | #endif
5225 | #ifndef SvPV_force_flags_mutable
5226 | #  define SvPV_force_flags_mutable(sv, lp, flags) \
5227 |                  ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5228 |                  ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
5229 |                   : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5230 | #endif
5231 | #ifndef SvPV_nolen
5232 | #  define SvPV_nolen(sv)                 \
5233 |                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5234 |                   ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
5235 | #endif
5236 | #ifndef SvPV_nolen_const
5237 | #  define SvPV_nolen_const(sv)           \
5238 |                  ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5239 |                   ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
5240 | #endif
5241 | #ifndef SvPV_nomg
5242 | #  define SvPV_nomg(sv, lp)              SvPV_flags(sv, lp, 0)
5243 | #endif
5244 | 
5245 | #ifndef SvPV_nomg_const
5246 | #  define SvPV_nomg_const(sv, lp)        SvPV_flags_const(sv, lp, 0)
5247 | #endif
5248 | 
5249 | #ifndef SvPV_nomg_const_nolen
5250 | #  define SvPV_nomg_const_nolen(sv)      SvPV_flags_const_nolen(sv, 0)
5251 | #endif
5252 | #ifndef SvPV_renew
5253 | #  define SvPV_renew(sv,n)               STMT_START { SvLEN_set(sv, n); \
5254 |                  SvPV_set((sv), (char *) saferealloc(          \
5255 |                        (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
5256 |                } STMT_END
5257 | #endif
5258 | #ifndef SvMAGIC_set
5259 | #  define SvMAGIC_set(sv, val)           \
5260 |                 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5261 |                 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5262 | #endif
5263 | 
5264 | #if (PERL_BCDVERSION < 0x5009003)
5265 | #ifndef SvPVX_const
5266 | #  define SvPVX_const(sv)                ((const char*) (0 + SvPVX(sv)))
5267 | #endif
5268 | 
5269 | #ifndef SvPVX_mutable
5270 | #  define SvPVX_mutable(sv)              (0 + SvPVX(sv))
5271 | #endif
5272 | #ifndef SvRV_set
5273 | #  define SvRV_set(sv, val)              \
5274 |                 STMT_START { assert(SvTYPE(sv) >=  SVt_RV); \
5275 |                 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5276 | #endif
5277 | 
5278 | #else
5279 | #ifndef SvPVX_const
5280 | #  define SvPVX_const(sv)                ((const char*)((sv)->sv_u.svu_pv))
5281 | #endif
5282 | 
5283 | #ifndef SvPVX_mutable
5284 | #  define SvPVX_mutable(sv)              ((sv)->sv_u.svu_pv)
5285 | #endif
5286 | #ifndef SvRV_set
5287 | #  define SvRV_set(sv, val)              \
5288 |                 STMT_START { assert(SvTYPE(sv) >=  SVt_RV); \
5289 |                 ((sv)->sv_u.svu_rv = (val)); } STMT_END
5290 | #endif
5291 | 
5292 | #endif
5293 | #ifndef SvSTASH_set
5294 | #  define SvSTASH_set(sv, val)           \
5295 |                 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5296 |                 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5297 | #endif
5298 | 
5299 | #if (PERL_BCDVERSION < 0x5004000)
5300 | #ifndef SvUV_set
5301 | #  define SvUV_set(sv, val)              \
5302 |                 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5303 |                 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5304 | #endif
5305 | 
5306 | #else
5307 | #ifndef SvUV_set
5308 | #  define SvUV_set(sv, val)              \
5309 |                 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5310 |                 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5311 | #endif
5312 | 
5313 | #endif
5314 | 
5315 | #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
5316 | #if defined(NEED_vnewSVpvf)
5317 | static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
5318 | static
5319 | #else
5320 | extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
5321 | #endif
5322 | 
5323 | #ifdef vnewSVpvf
5324 | #  undef vnewSVpvf
5325 | #endif
5326 | #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5327 | #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5328 | 
5329 | #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5330 | 
5331 | SV *
5332 | DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
5333 | {
5334 |   register SV *sv = newSV(0);
5335 |   sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
5336 |   return sv;
5337 | }
5338 | 
5339 | #endif
5340 | #endif
5341 | 
5342 | #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
5343 | #  define sv_vcatpvf(sv, pat, args)  sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5344 | #endif
5345 | 
5346 | #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
5347 | #  define sv_vsetpvf(sv, pat, args)  sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5348 | #endif
5349 | 
5350 | #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
5351 | #if defined(NEED_sv_catpvf_mg)
5352 | static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5353 | static
5354 | #else
5355 | extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5356 | #endif
5357 | 
5358 | #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5359 | 
5360 | #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5361 | 
5362 | void
5363 | DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5364 | {
5365 |   va_list args;
5366 |   va_start(args, pat);
5367 |   sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5368 |   SvSETMAGIC(sv);
5369 |   va_end(args);
5370 | }
5371 | 
5372 | #endif
5373 | #endif
5374 | 
5375 | #ifdef PERL_IMPLICIT_CONTEXT
5376 | #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
5377 | #if defined(NEED_sv_catpvf_mg_nocontext)
5378 | static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5379 | static
5380 | #else
5381 | extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5382 | #endif
5383 | 
5384 | #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5385 | #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5386 | 
5387 | #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
5388 | 
5389 | void
5390 | DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5391 | {
5392 |   dTHX;
5393 |   va_list args;
5394 |   va_start(args, pat);
5395 |   sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5396 |   SvSETMAGIC(sv);
5397 |   va_end(args);
5398 | }
5399 | 
5400 | #endif
5401 | #endif
5402 | #endif
5403 | 
5404 | /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
5405 | #ifndef sv_catpvf_mg
5406 | #  ifdef PERL_IMPLICIT_CONTEXT
5407 | #    define sv_catpvf_mg   Perl_sv_catpvf_mg_nocontext
5408 | #  else
5409 | #    define sv_catpvf_mg   Perl_sv_catpvf_mg
5410 | #  endif
5411 | #endif
5412 | 
5413 | #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
5414 | #  define sv_vcatpvf_mg(sv, pat, args)                                     \
5415 |    STMT_START {                                                            \
5416 |      sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));  \
5417 |      SvSETMAGIC(sv);                                                       \
5418 |    } STMT_END
5419 | #endif
5420 | 
5421 | #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
5422 | #if defined(NEED_sv_setpvf_mg)
5423 | static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5424 | static
5425 | #else
5426 | extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5427 | #endif
5428 | 
5429 | #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
5430 | 
5431 | #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
5432 | 
5433 | void
5434 | DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5435 | {
5436 |   va_list args;
5437 |   va_start(args, pat);
5438 |   sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5439 |   SvSETMAGIC(sv);
5440 |   va_end(args);
5441 | }
5442 | 
5443 | #endif
5444 | #endif
5445 | 
5446 | #ifdef PERL_IMPLICIT_CONTEXT
5447 | #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
5448 | #if defined(NEED_sv_setpvf_mg_nocontext)
5449 | static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5450 | static
5451 | #else
5452 | extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5453 | #endif
5454 | 
5455 | #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5456 | #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5457 | 
5458 | #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
5459 | 
5460 | void
5461 | DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5462 | {
5463 |   dTHX;
5464 |   va_list args;
5465 |   va_start(args, pat);
5466 |   sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5467 |   SvSETMAGIC(sv);
5468 |   va_end(args);
5469 | }
5470 | 
5471 | #endif
5472 | #endif
5473 | #endif
5474 | 
5475 | /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
5476 | #ifndef sv_setpvf_mg
5477 | #  ifdef PERL_IMPLICIT_CONTEXT
5478 | #    define sv_setpvf_mg   Perl_sv_setpvf_mg_nocontext
5479 | #  else
5480 | #    define sv_setpvf_mg   Perl_sv_setpvf_mg
5481 | #  endif
5482 | #endif
5483 | 
5484 | #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
5485 | #  define sv_vsetpvf_mg(sv, pat, args)                                     \
5486 |    STMT_START {                                                            \
5487 |      sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));  \
5488 |      SvSETMAGIC(sv);                                                       \
5489 |    } STMT_END
5490 | #endif
5491 | 
5492 | /* Hint: newSVpvn_share
5493 |  * The SVs created by this function only mimic the behaviour of
5494 |  * shared PVs without really being shared. Only use if you know
5495 |  * what you're doing.
5496 |  */
5497 | 
5498 | #ifndef newSVpvn_share
5499 | 
5500 | #if defined(NEED_newSVpvn_share)
5501 | static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
5502 | static
5503 | #else
5504 | extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
5505 | #endif
5506 | 
5507 | #ifdef newSVpvn_share
5508 | #  undef newSVpvn_share
5509 | #endif
5510 | #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
5511 | #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
5512 | 
5513 | #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
5514 | 
5515 | SV *
5516 | DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
5517 | {
5518 |   SV *sv;
5519 |   if (len < 0)
5520 |     len = -len;
5521 |   if (!hash)
5522 |     PERL_HASH(hash, (char*) src, len);
5523 |   sv = newSVpvn((char *) src, len);
5524 |   sv_upgrade(sv, SVt_PVIV);
5525 |   SvIVX(sv) = hash;
5526 |   SvREADONLY_on(sv);
5527 |   SvPOK_on(sv);
5528 |   return sv;
5529 | }
5530 | 
5531 | #endif
5532 | 
5533 | #endif
5534 | #ifndef SvSHARED_HASH
5535 | #  define SvSHARED_HASH(sv)              (0 + SvUVX(sv))
5536 | #endif
5537 | #ifndef HvNAME_get
5538 | #  define HvNAME_get(hv)                 HvNAME(hv)
5539 | #endif
5540 | #ifndef HvNAMELEN_get
5541 | #  define HvNAMELEN_get(hv)              (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
5542 | #endif
5543 | #ifndef GvSVn
5544 | #  define GvSVn(gv)                      GvSV(gv)
5545 | #endif
5546 | 
5547 | #ifndef isGV_with_GP
5548 | #  define isGV_with_GP(gv)               isGV(gv)
5549 | #endif
5550 | 
5551 | #ifndef gv_fetchpvn_flags
5552 | #  define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
5553 | #endif
5554 | 
5555 | #ifndef gv_fetchsv
5556 | #  define gv_fetchsv(name, flags, svt)   gv_fetchpv(SvPV_nolen_const(name), flags, svt)
5557 | #endif
5558 | #ifndef get_cvn_flags
5559 | #  define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
5560 | #endif
5561 | #ifndef WARN_ALL
5562 | #  define WARN_ALL                       0
5563 | #endif
5564 | 
5565 | #ifndef WARN_CLOSURE
5566 | #  define WARN_CLOSURE                   1
5567 | #endif
5568 | 
5569 | #ifndef WARN_DEPRECATED
5570 | #  define WARN_DEPRECATED                2
5571 | #endif
5572 | 
5573 | #ifndef WARN_EXITING
5574 | #  define WARN_EXITING                   3
5575 | #endif
5576 | 
5577 | #ifndef WARN_GLOB
5578 | #  define WARN_GLOB                      4
5579 | #endif
5580 | 
5581 | #ifndef WARN_IO
5582 | #  define WARN_IO                        5
5583 | #endif
5584 | 
5585 | #ifndef WARN_CLOSED
5586 | #  define WARN_CLOSED                    6
5587 | #endif
5588 | 
5589 | #ifndef WARN_EXEC
5590 | #  define WARN_EXEC                      7
5591 | #endif
5592 | 
5593 | #ifndef WARN_LAYER
5594 | #  define WARN_LAYER                     8
5595 | #endif
5596 | 
5597 | #ifndef WARN_NEWLINE
5598 | #  define WARN_NEWLINE                   9
5599 | #endif
5600 | 
5601 | #ifndef WARN_PIPE
5602 | #  define WARN_PIPE                      10
5603 | #endif
5604 | 
5605 | #ifndef WARN_UNOPENED
5606 | #  define WARN_UNOPENED                  11
5607 | #endif
5608 | 
5609 | #ifndef WARN_MISC
5610 | #  define WARN_MISC                      12
5611 | #endif
5612 | 
5613 | #ifndef WARN_NUMERIC
5614 | #  define WARN_NUMERIC                   13
5615 | #endif
5616 | 
5617 | #ifndef WARN_ONCE
5618 | #  define WARN_ONCE                      14
5619 | #endif
5620 | 
5621 | #ifndef WARN_OVERFLOW
5622 | #  define WARN_OVERFLOW                  15
5623 | #endif
5624 | 
5625 | #ifndef WARN_PACK
5626 | #  define WARN_PACK                      16
5627 | #endif
5628 | 
5629 | #ifndef WARN_PORTABLE
5630 | #  define WARN_PORTABLE                  17
5631 | #endif
5632 | 
5633 | #ifndef WARN_RECURSION
5634 | #  define WARN_RECURSION                 18
5635 | #endif
5636 | 
5637 | #ifndef WARN_REDEFINE
5638 | #  define WARN_REDEFINE                  19
5639 | #endif
5640 | 
5641 | #ifndef WARN_REGEXP
5642 | #  define WARN_REGEXP                    20
5643 | #endif
5644 | 
5645 | #ifndef WARN_SEVERE
5646 | #  define WARN_SEVERE                    21
5647 | #endif
5648 | 
5649 | #ifndef WARN_DEBUGGING
5650 | #  define WARN_DEBUGGING                 22
5651 | #endif
5652 | 
5653 | #ifndef WARN_INPLACE
5654 | #  define WARN_INPLACE                   23
5655 | #endif
5656 | 
5657 | #ifndef WARN_INTERNAL
5658 | #  define WARN_INTERNAL                  24
5659 | #endif
5660 | 
5661 | #ifndef WARN_MALLOC
5662 | #  define WARN_MALLOC                    25
5663 | #endif
5664 | 
5665 | #ifndef WARN_SIGNAL
5666 | #  define WARN_SIGNAL                    26
5667 | #endif
5668 | 
5669 | #ifndef WARN_SUBSTR
5670 | #  define WARN_SUBSTR                    27
5671 | #endif
5672 | 
5673 | #ifndef WARN_SYNTAX
5674 | #  define WARN_SYNTAX                    28
5675 | #endif
5676 | 
5677 | #ifndef WARN_AMBIGUOUS
5678 | #  define WARN_AMBIGUOUS                 29
5679 | #endif
5680 | 
5681 | #ifndef WARN_BAREWORD
5682 | #  define WARN_BAREWORD                  30
5683 | #endif
5684 | 
5685 | #ifndef WARN_DIGIT
5686 | #  define WARN_DIGIT                     31
5687 | #endif
5688 | 
5689 | #ifndef WARN_PARENTHESIS
5690 | #  define WARN_PARENTHESIS               32
5691 | #endif
5692 | 
5693 | #ifndef WARN_PRECEDENCE
5694 | #  define WARN_PRECEDENCE                33
5695 | #endif
5696 | 
5697 | #ifndef WARN_PRINTF
5698 | #  define WARN_PRINTF                    34
5699 | #endif
5700 | 
5701 | #ifndef WARN_PROTOTYPE
5702 | #  define WARN_PROTOTYPE                 35
5703 | #endif
5704 | 
5705 | #ifndef WARN_QW
5706 | #  define WARN_QW                        36
5707 | #endif
5708 | 
5709 | #ifndef WARN_RESERVED
5710 | #  define WARN_RESERVED                  37
5711 | #endif
5712 | 
5713 | #ifndef WARN_SEMICOLON
5714 | #  define WARN_SEMICOLON                 38
5715 | #endif
5716 | 
5717 | #ifndef WARN_TAINT
5718 | #  define WARN_TAINT                     39
5719 | #endif
5720 | 
5721 | #ifndef WARN_THREADS
5722 | #  define WARN_THREADS                   40
5723 | #endif
5724 | 
5725 | #ifndef WARN_UNINITIALIZED
5726 | #  define WARN_UNINITIALIZED             41
5727 | #endif
5728 | 
5729 | #ifndef WARN_UNPACK
5730 | #  define WARN_UNPACK                    42
5731 | #endif
5732 | 
5733 | #ifndef WARN_UNTIE
5734 | #  define WARN_UNTIE                     43
5735 | #endif
5736 | 
5737 | #ifndef WARN_UTF8
5738 | #  define WARN_UTF8                      44
5739 | #endif
5740 | 
5741 | #ifndef WARN_VOID
5742 | #  define WARN_VOID                      45
5743 | #endif
5744 | 
5745 | #ifndef WARN_ASSERTIONS
5746 | #  define WARN_ASSERTIONS                46
5747 | #endif
5748 | #ifndef packWARN
5749 | #  define packWARN(a)                    (a)
5750 | #endif
5751 | 
5752 | #ifndef ckWARN
5753 | #  ifdef G_WARN_ON
5754 | #    define  ckWARN(a)                  (PL_dowarn & G_WARN_ON)
5755 | #  else
5756 | #    define  ckWARN(a)                  PL_dowarn
5757 | #  endif
5758 | #endif
5759 | 
5760 | #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
5761 | #if defined(NEED_warner)
5762 | static void DPPP_(my_warner)(U32 err, const char *pat, ...);
5763 | static
5764 | #else
5765 | extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
5766 | #endif
5767 | 
5768 | #define Perl_warner DPPP_(my_warner)
5769 | 
5770 | #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
5771 | 
5772 | void
5773 | DPPP_(my_warner)(U32 err, const char *pat, ...)
5774 | {
5775 |   SV *sv;
5776 |   va_list args;
5777 | 
5778 |   PERL_UNUSED_ARG(err);
5779 | 
5780 |   va_start(args, pat);
5781 |   sv = vnewSVpvf(pat, &args);
5782 |   va_end(args);
5783 |   sv_2mortal(sv);
5784 |   warn("%s", SvPV_nolen(sv));
5785 | }
5786 | 
5787 | #define warner  Perl_warner
5788 | 
5789 | #define Perl_warner_nocontext  Perl_warner
5790 | 
5791 | #endif
5792 | #endif
5793 | 
5794 | /* concatenating with "" ensures that only literal strings are accepted as argument
5795 |  * note that STR_WITH_LEN() can't be used as argument to macros or functions that
5796 |  * under some configurations might be macros
5797 |  */
5798 | #ifndef STR_WITH_LEN
5799 | #  define STR_WITH_LEN(s)                (s ""), (sizeof(s)-1)
5800 | #endif
5801 | #ifndef newSVpvs
5802 | #  define newSVpvs(str)                  newSVpvn(str "", sizeof(str) - 1)
5803 | #endif
5804 | 
5805 | #ifndef newSVpvs_flags
5806 | #  define newSVpvs_flags(str, flags)     newSVpvn_flags(str "", sizeof(str) - 1, flags)
5807 | #endif
5808 | 
5809 | #ifndef newSVpvs_share
5810 | #  define newSVpvs_share(str)            newSVpvn_share(str "", sizeof(str) - 1, 0)
5811 | #endif
5812 | 
5813 | #ifndef sv_catpvs
5814 | #  define sv_catpvs(sv, str)             sv_catpvn(sv, str "", sizeof(str) - 1)
5815 | #endif
5816 | 
5817 | #ifndef sv_setpvs
5818 | #  define sv_setpvs(sv, str)             sv_setpvn(sv, str "", sizeof(str) - 1)
5819 | #endif
5820 | 
5821 | #ifndef hv_fetchs
5822 | #  define hv_fetchs(hv, key, lval)       hv_fetch(hv, key "", sizeof(key) - 1, lval)
5823 | #endif
5824 | 
5825 | #ifndef hv_stores
5826 | #  define hv_stores(hv, key, val)        hv_store(hv, key "", sizeof(key) - 1, val, 0)
5827 | #endif
5828 | #ifndef gv_fetchpvs
5829 | #  define gv_fetchpvs(name, flags, svt)  gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
5830 | #endif
5831 | 
5832 | #ifndef gv_stashpvs
5833 | #  define gv_stashpvs(name, flags)       gv_stashpvn(name "", sizeof(name) - 1, flags)
5834 | #endif
5835 | #ifndef get_cvs
5836 | #  define get_cvs(name, flags)           get_cvn_flags(name "", sizeof(name)-1, flags)
5837 | #endif
5838 | #ifndef SvGETMAGIC
5839 | #  define SvGETMAGIC(x)                  STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
5840 | #endif
5841 | #ifndef PERL_MAGIC_sv
5842 | #  define PERL_MAGIC_sv                  '\0'
5843 | #endif
5844 | 
5845 | #ifndef PERL_MAGIC_overload
5846 | #  define PERL_MAGIC_overload            'A'
5847 | #endif
5848 | 
5849 | #ifndef PERL_MAGIC_overload_elem
5850 | #  define PERL_MAGIC_overload_elem       'a'
5851 | #endif
5852 | 
5853 | #ifndef PERL_MAGIC_overload_table
5854 | #  define PERL_MAGIC_overload_table      'c'
5855 | #endif
5856 | 
5857 | #ifndef PERL_MAGIC_bm
5858 | #  define PERL_MAGIC_bm                  'B'
5859 | #endif
5860 | 
5861 | #ifndef PERL_MAGIC_regdata
5862 | #  define PERL_MAGIC_regdata             'D'
5863 | #endif
5864 | 
5865 | #ifndef PERL_MAGIC_regdatum
5866 | #  define PERL_MAGIC_regdatum            'd'
5867 | #endif
5868 | 
5869 | #ifndef PERL_MAGIC_env
5870 | #  define PERL_MAGIC_env                 'E'
5871 | #endif
5872 | 
5873 | #ifndef PERL_MAGIC_envelem
5874 | #  define PERL_MAGIC_envelem             'e'
5875 | #endif
5876 | 
5877 | #ifndef PERL_MAGIC_fm
5878 | #  define PERL_MAGIC_fm                  'f'
5879 | #endif
5880 | 
5881 | #ifndef PERL_MAGIC_regex_global
5882 | #  define PERL_MAGIC_regex_global        'g'
5883 | #endif
5884 | 
5885 | #ifndef PERL_MAGIC_isa
5886 | #  define PERL_MAGIC_isa                 'I'
5887 | #endif
5888 | 
5889 | #ifndef PERL_MAGIC_isaelem
5890 | #  define PERL_MAGIC_isaelem             'i'
5891 | #endif
5892 | 
5893 | #ifndef PERL_MAGIC_nkeys
5894 | #  define PERL_MAGIC_nkeys               'k'
5895 | #endif
5896 | 
5897 | #ifndef PERL_MAGIC_dbfile
5898 | #  define PERL_MAGIC_dbfile              'L'
5899 | #endif
5900 | 
5901 | #ifndef PERL_MAGIC_dbline
5902 | #  define PERL_MAGIC_dbline              'l'
5903 | #endif
5904 | 
5905 | #ifndef PERL_MAGIC_mutex
5906 | #  define PERL_MAGIC_mutex               'm'
5907 | #endif
5908 | 
5909 | #ifndef PERL_MAGIC_shared
5910 | #  define PERL_MAGIC_shared              'N'
5911 | #endif
5912 | 
5913 | #ifndef PERL_MAGIC_shared_scalar
5914 | #  define PERL_MAGIC_shared_scalar       'n'
5915 | #endif
5916 | 
5917 | #ifndef PERL_MAGIC_collxfrm
5918 | #  define PERL_MAGIC_collxfrm            'o'
5919 | #endif
5920 | 
5921 | #ifndef PERL_MAGIC_tied
5922 | #  define PERL_MAGIC_tied                'P'
5923 | #endif
5924 | 
5925 | #ifndef PERL_MAGIC_tiedelem
5926 | #  define PERL_MAGIC_tiedelem            'p'
5927 | #endif
5928 | 
5929 | #ifndef PERL_MAGIC_tiedscalar
5930 | #  define PERL_MAGIC_tiedscalar          'q'
5931 | #endif
5932 | 
5933 | #ifndef PERL_MAGIC_qr
5934 | #  define PERL_MAGIC_qr                  'r'
5935 | #endif
5936 | 
5937 | #ifndef PERL_MAGIC_sig
5938 | #  define PERL_MAGIC_sig                 'S'
5939 | #endif
5940 | 
5941 | #ifndef PERL_MAGIC_sigelem
5942 | #  define PERL_MAGIC_sigelem             's'
5943 | #endif
5944 | 
5945 | #ifndef PERL_MAGIC_taint
5946 | #  define PERL_MAGIC_taint               't'
5947 | #endif
5948 | 
5949 | #ifndef PERL_MAGIC_uvar
5950 | #  define PERL_MAGIC_uvar                'U'
5951 | #endif
5952 | 
5953 | #ifndef PERL_MAGIC_uvar_elem
5954 | #  define PERL_MAGIC_uvar_elem           'u'
5955 | #endif
5956 | 
5957 | #ifndef PERL_MAGIC_vstring
5958 | #  define PERL_MAGIC_vstring             'V'
5959 | #endif
5960 | 
5961 | #ifndef PERL_MAGIC_vec
5962 | #  define PERL_MAGIC_vec                 'v'
5963 | #endif
5964 | 
5965 | #ifndef PERL_MAGIC_utf8
5966 | #  define PERL_MAGIC_utf8                'w'
5967 | #endif
5968 | 
5969 | #ifndef PERL_MAGIC_substr
5970 | #  define PERL_MAGIC_substr              'x'
5971 | #endif
5972 | 
5973 | #ifndef PERL_MAGIC_defelem
5974 | #  define PERL_MAGIC_defelem             'y'
5975 | #endif
5976 | 
5977 | #ifndef PERL_MAGIC_glob
5978 | #  define PERL_MAGIC_glob                '*'
5979 | #endif
5980 | 
5981 | #ifndef PERL_MAGIC_arylen
5982 | #  define PERL_MAGIC_arylen              '#'
5983 | #endif
5984 | 
5985 | #ifndef PERL_MAGIC_pos
5986 | #  define PERL_MAGIC_pos                 '.'
5987 | #endif
5988 | 
5989 | #ifndef PERL_MAGIC_backref
5990 | #  define PERL_MAGIC_backref             '<'
5991 | #endif
5992 | 
5993 | #ifndef PERL_MAGIC_ext
5994 | #  define PERL_MAGIC_ext                 '~'
5995 | #endif
5996 | 
5997 | /* That's the best we can do... */
5998 | #ifndef sv_catpvn_nomg
5999 | #  define sv_catpvn_nomg                 sv_catpvn
6000 | #endif
6001 | 
6002 | #ifndef sv_catsv_nomg
6003 | #  define sv_catsv_nomg                  sv_catsv
6004 | #endif
6005 | 
6006 | #ifndef sv_setsv_nomg
6007 | #  define sv_setsv_nomg                  sv_setsv
6008 | #endif
6009 | 
6010 | #ifndef sv_pvn_nomg
6011 | #  define sv_pvn_nomg                    sv_pvn
6012 | #endif
6013 | 
6014 | #ifndef SvIV_nomg
6015 | #  define SvIV_nomg                      SvIV
6016 | #endif
6017 | 
6018 | #ifndef SvUV_nomg
6019 | #  define SvUV_nomg                      SvUV
6020 | #endif
6021 | 
6022 | #ifndef sv_catpv_mg
6023 | #  define sv_catpv_mg(sv, ptr)          \
6024 |    STMT_START {                         \
6025 |      SV *TeMpSv = sv;                   \
6026 |      sv_catpv(TeMpSv,ptr);              \
6027 |      SvSETMAGIC(TeMpSv);                \
6028 |    } STMT_END
6029 | #endif
6030 | 
6031 | #ifndef sv_catpvn_mg
6032 | #  define sv_catpvn_mg(sv, ptr, len)    \
6033 |    STMT_START {                         \
6034 |      SV *TeMpSv = sv;                   \
6035 |      sv_catpvn(TeMpSv,ptr,len);         \
6036 |      SvSETMAGIC(TeMpSv);                \
6037 |    } STMT_END
6038 | #endif
6039 | 
6040 | #ifndef sv_catsv_mg
6041 | #  define sv_catsv_mg(dsv, ssv)         \
6042 |    STMT_START {                         \
6043 |      SV *TeMpSv = dsv;                  \
6044 |      sv_catsv(TeMpSv,ssv);              \
6045 |      SvSETMAGIC(TeMpSv);                \
6046 |    } STMT_END
6047 | #endif
6048 | 
6049 | #ifndef sv_setiv_mg
6050 | #  define sv_setiv_mg(sv, i)            \
6051 |    STMT_START {                         \
6052 |      SV *TeMpSv = sv;                   \
6053 |      sv_setiv(TeMpSv,i);                \
6054 |      SvSETMAGIC(TeMpSv);                \
6055 |    } STMT_END
6056 | #endif
6057 | 
6058 | #ifndef sv_setnv_mg
6059 | #  define sv_setnv_mg(sv, num)          \
6060 |    STMT_START {                         \
6061 |      SV *TeMpSv = sv;                   \
6062 |      sv_setnv(TeMpSv,num);              \
6063 |      SvSETMAGIC(TeMpSv);                \
6064 |    } STMT_END
6065 | #endif
6066 | 
6067 | #ifndef sv_setpv_mg
6068 | #  define sv_setpv_mg(sv, ptr)          \
6069 |    STMT_START {                         \
6070 |      SV *TeMpSv = sv;                   \
6071 |      sv_setpv(TeMpSv,ptr);              \
6072 |      SvSETMAGIC(TeMpSv);                \
6073 |    } STMT_END
6074 | #endif
6075 | 
6076 | #ifndef sv_setpvn_mg
6077 | #  define sv_setpvn_mg(sv, ptr, len)    \
6078 |    STMT_START {                         \
6079 |      SV *TeMpSv = sv;                   \
6080 |      sv_setpvn(TeMpSv,ptr,len);         \
6081 |      SvSETMAGIC(TeMpSv);                \
6082 |    } STMT_END
6083 | #endif
6084 | 
6085 | #ifndef sv_setsv_mg
6086 | #  define sv_setsv_mg(dsv, ssv)         \
6087 |    STMT_START {                         \
6088 |      SV *TeMpSv = dsv;                  \
6089 |      sv_setsv(TeMpSv,ssv);              \
6090 |      SvSETMAGIC(TeMpSv);                \
6091 |    } STMT_END
6092 | #endif
6093 | 
6094 | #ifndef sv_setuv_mg
6095 | #  define sv_setuv_mg(sv, i)            \
6096 |    STMT_START {                         \
6097 |      SV *TeMpSv = sv;                   \
6098 |      sv_setuv(TeMpSv,i);                \
6099 |      SvSETMAGIC(TeMpSv);                \
6100 |    } STMT_END
6101 | #endif
6102 | 
6103 | #ifndef sv_usepvn_mg
6104 | #  define sv_usepvn_mg(sv, ptr, len)    \
6105 |    STMT_START {                         \
6106 |      SV *TeMpSv = sv;                   \
6107 |      sv_usepvn(TeMpSv,ptr,len);         \
6108 |      SvSETMAGIC(TeMpSv);                \
6109 |    } STMT_END
6110 | #endif
6111 | #ifndef SvVSTRING_mg
6112 | #  define SvVSTRING_mg(sv)               (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
6113 | #endif
6114 | 
6115 | /* Hint: sv_magic_portable
6116 |  * This is a compatibility function that is only available with
6117 |  * Devel::PPPort. It is NOT in the perl core.
6118 |  * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
6119 |  * it is being passed a name pointer with namlen == 0. In that
6120 |  * case, perl 5.8.0 and later store the pointer, not a copy of it.
6121 |  * The compatibility can be provided back to perl 5.004. With
6122 |  * earlier versions, the code will not compile.
6123 |  */
6124 | 
6125 | #if (PERL_BCDVERSION < 0x5004000)
6126 | 
6127 |   /* code that uses sv_magic_portable will not compile */
6128 | 
6129 | #elif (PERL_BCDVERSION < 0x5008000)
6130 | 
6131 | #  define sv_magic_portable(sv, obj, how, name, namlen)     \
6132 |    STMT_START {                                             \
6133 |      SV *SvMp_sv = (sv);                                    \
6134 |      char *SvMp_name = (char *) (name);                     \
6135 |      I32 SvMp_namlen = (namlen);                            \
6136 |      if (SvMp_name && SvMp_namlen == 0)                     \
6137 |      {                                                      \
6138 |        MAGIC *mg;                                           \
6139 |        sv_magic(SvMp_sv, obj, how, 0, 0);                   \
6140 |        mg = SvMAGIC(SvMp_sv);                               \
6141 |        mg->mg_len = -42; /* XXX: this is the tricky part */ \
6142 |        mg->mg_ptr = SvMp_name;                              \
6143 |      }                                                      \
6144 |      else                                                   \
6145 |      {                                                      \
6146 |        sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
6147 |      }                                                      \
6148 |    } STMT_END
6149 | 
6150 | #else
6151 | 
6152 | #  define sv_magic_portable(a, b, c, d, e)  sv_magic(a, b, c, d, e)
6153 | 
6154 | #endif
6155 | 
6156 | #ifdef USE_ITHREADS
6157 | #ifndef CopFILE
6158 | #  define CopFILE(c)                     ((c)->cop_file)
6159 | #endif
6160 | 
6161 | #ifndef CopFILEGV
6162 | #  define CopFILEGV(c)                   (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
6163 | #endif
6164 | 
6165 | #ifndef CopFILE_set
6166 | #  define CopFILE_set(c,pv)              ((c)->cop_file = savepv(pv))
6167 | #endif
6168 | 
6169 | #ifndef CopFILESV
6170 | #  define CopFILESV(c)                   (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
6171 | #endif
6172 | 
6173 | #ifndef CopFILEAV
6174 | #  define CopFILEAV(c)                   (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
6175 | #endif
6176 | 
6177 | #ifndef CopSTASHPV
6178 | #  define CopSTASHPV(c)                  ((c)->cop_stashpv)
6179 | #endif
6180 | 
6181 | #ifndef CopSTASHPV_set
6182 | #  define CopSTASHPV_set(c,pv)           ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
6183 | #endif
6184 | 
6185 | #ifndef CopSTASH
6186 | #  define CopSTASH(c)                    (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
6187 | #endif
6188 | 
6189 | #ifndef CopSTASH_set
6190 | #  define CopSTASH_set(c,hv)             CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
6191 | #endif
6192 | 
6193 | #ifndef CopSTASH_eq
6194 | #  define CopSTASH_eq(c,hv)              ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6195 | 					|| (CopSTASHPV(c) && HvNAME(hv) \
6196 | 					&& strEQ(CopSTASHPV(c), HvNAME(hv)))))
6197 | #endif
6198 | 
6199 | #else
6200 | #ifndef CopFILEGV
6201 | #  define CopFILEGV(c)                   ((c)->cop_filegv)
6202 | #endif
6203 | 
6204 | #ifndef CopFILEGV_set
6205 | #  define CopFILEGV_set(c,gv)            ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6206 | #endif
6207 | 
6208 | #ifndef CopFILE_set
6209 | #  define CopFILE_set(c,pv)              CopFILEGV_set((c), gv_fetchfile(pv))
6210 | #endif
6211 | 
6212 | #ifndef CopFILESV
6213 | #  define CopFILESV(c)                   (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6214 | #endif
6215 | 
6216 | #ifndef CopFILEAV
6217 | #  define CopFILEAV(c)                   (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6218 | #endif
6219 | 
6220 | #ifndef CopFILE
6221 | #  define CopFILE(c)                     (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6222 | #endif
6223 | 
6224 | #ifndef CopSTASH
6225 | #  define CopSTASH(c)                    ((c)->cop_stash)
6226 | #endif
6227 | 
6228 | #ifndef CopSTASH_set
6229 | #  define CopSTASH_set(c,hv)             ((c)->cop_stash = (hv))
6230 | #endif
6231 | 
6232 | #ifndef CopSTASHPV
6233 | #  define CopSTASHPV(c)                  (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6234 | #endif
6235 | 
6236 | #ifndef CopSTASHPV_set
6237 | #  define CopSTASHPV_set(c,pv)           CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6238 | #endif
6239 | 
6240 | #ifndef CopSTASH_eq
6241 | #  define CopSTASH_eq(c,hv)              (CopSTASH(c) == (hv))
6242 | #endif
6243 | 
6244 | #endif /* USE_ITHREADS */
6245 | #ifndef IN_PERL_COMPILETIME
6246 | #  define IN_PERL_COMPILETIME            (PL_curcop == &PL_compiling)
6247 | #endif
6248 | 
6249 | #ifndef IN_LOCALE_RUNTIME
6250 | #  define IN_LOCALE_RUNTIME              (PL_curcop->op_private & HINT_LOCALE)
6251 | #endif
6252 | 
6253 | #ifndef IN_LOCALE_COMPILETIME
6254 | #  define IN_LOCALE_COMPILETIME          (PL_hints & HINT_LOCALE)
6255 | #endif
6256 | 
6257 | #ifndef IN_LOCALE
6258 | #  define IN_LOCALE                      (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6259 | #endif
6260 | #ifndef IS_NUMBER_IN_UV
6261 | #  define IS_NUMBER_IN_UV                0x01
6262 | #endif
6263 | 
6264 | #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6265 | #  define IS_NUMBER_GREATER_THAN_UV_MAX  0x02
6266 | #endif
6267 | 
6268 | #ifndef IS_NUMBER_NOT_INT
6269 | #  define IS_NUMBER_NOT_INT              0x04
6270 | #endif
6271 | 
6272 | #ifndef IS_NUMBER_NEG
6273 | #  define IS_NUMBER_NEG                  0x08
6274 | #endif
6275 | 
6276 | #ifndef IS_NUMBER_INFINITY
6277 | #  define IS_NUMBER_INFINITY             0x10
6278 | #endif
6279 | 
6280 | #ifndef IS_NUMBER_NAN
6281 | #  define IS_NUMBER_NAN                  0x20
6282 | #endif
6283 | #ifndef GROK_NUMERIC_RADIX
6284 | #  define GROK_NUMERIC_RADIX(sp, send)   grok_numeric_radix(sp, send)
6285 | #endif
6286 | #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6287 | #  define PERL_SCAN_GREATER_THAN_UV_MAX  0x02
6288 | #endif
6289 | 
6290 | #ifndef PERL_SCAN_SILENT_ILLDIGIT
6291 | #  define PERL_SCAN_SILENT_ILLDIGIT      0x04
6292 | #endif
6293 | 
6294 | #ifndef PERL_SCAN_ALLOW_UNDERSCORES
6295 | #  define PERL_SCAN_ALLOW_UNDERSCORES    0x01
6296 | #endif
6297 | 
6298 | #ifndef PERL_SCAN_DISALLOW_PREFIX
6299 | #  define PERL_SCAN_DISALLOW_PREFIX      0x02
6300 | #endif
6301 | 
6302 | #ifndef grok_numeric_radix
6303 | #if defined(NEED_grok_numeric_radix)
6304 | static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6305 | static
6306 | #else
6307 | extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6308 | #endif
6309 | 
6310 | #ifdef grok_numeric_radix
6311 | #  undef grok_numeric_radix
6312 | #endif
6313 | #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6314 | #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6315 | 
6316 | #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6317 | bool
6318 | DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
6319 | {
6320 | #ifdef USE_LOCALE_NUMERIC
6321 | #ifdef PL_numeric_radix_sv
6322 |     if (PL_numeric_radix_sv && IN_LOCALE) {
6323 |         STRLEN len;
6324 |         char* radix = SvPV(PL_numeric_radix_sv, len);
6325 |         if (*sp + len <= send && memEQ(*sp, radix, len)) {
6326 |             *sp += len;
6327 |             return TRUE;
6328 |         }
6329 |     }
6330 | #else
6331 |     /* older perls don't have PL_numeric_radix_sv so the radix
6332 |      * must manually be requested from locale.h
6333 |      */
6334 | #include <locale.h>
6335 |     dTHR;  /* needed for older threaded perls */
6336 |     struct lconv *lc = localeconv();
6337 |     char *radix = lc->decimal_point;
6338 |     if (radix && IN_LOCALE) {
6339 |         STRLEN len = strlen(radix);
6340 |         if (*sp + len <= send && memEQ(*sp, radix, len)) {
6341 |             *sp += len;
6342 |             return TRUE;
6343 |         }
6344 |     }
6345 | #endif
6346 | #endif /* USE_LOCALE_NUMERIC */
6347 |     /* always try "." if numeric radix didn't match because
6348 |      * we may have data from different locales mixed */
6349 |     if (*sp < send && **sp == '.') {
6350 |         ++*sp;
6351 |         return TRUE;
6352 |     }
6353 |     return FALSE;
6354 | }
6355 | #endif
6356 | #endif
6357 | 
6358 | #ifndef grok_number
6359 | #if defined(NEED_grok_number)
6360 | static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6361 | static
6362 | #else
6363 | extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6364 | #endif
6365 | 
6366 | #ifdef grok_number
6367 | #  undef grok_number
6368 | #endif
6369 | #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6370 | #define Perl_grok_number DPPP_(my_grok_number)
6371 | 
6372 | #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6373 | int
6374 | DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
6375 | {
6376 |   const char *s = pv;
6377 |   const char *send = pv + len;
6378 |   const UV max_div_10 = UV_MAX / 10;
6379 |   const char max_mod_10 = UV_MAX % 10;
6380 |   int numtype = 0;
6381 |   int sawinf = 0;
6382 |   int sawnan = 0;
6383 | 
6384 |   while (s < send && isSPACE(*s))
6385 |     s++;
6386 |   if (s == send) {
6387 |     return 0;
6388 |   } else if (*s == '-') {
6389 |     s++;
6390 |     numtype = IS_NUMBER_NEG;
6391 |   }
6392 |   else if (*s == '+')
6393 |   s++;
6394 | 
6395 |   if (s == send)
6396 |     return 0;
6397 | 
6398 |   /* next must be digit or the radix separator or beginning of infinity */
6399 |   if (isDIGIT(*s)) {
6400 |     /* UVs are at least 32 bits, so the first 9 decimal digits cannot
6401 |        overflow.  */
6402 |     UV value = *s - '0';
6403 |     /* This construction seems to be more optimiser friendly.
6404 |        (without it gcc does the isDIGIT test and the *s - '0' separately)
6405 |        With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6406 |        In theory the optimiser could deduce how far to unroll the loop
6407 |        before checking for overflow.  */
6408 |     if (++s < send) {
6409 |       int digit = *s - '0';
6410 |       if (digit >= 0 && digit <= 9) {
6411 |         value = value * 10 + digit;
6412 |         if (++s < send) {
6413 |           digit = *s - '0';
6414 |           if (digit >= 0 && digit <= 9) {
6415 |             value = value * 10 + digit;
6416 |             if (++s < send) {
6417 |               digit = *s - '0';
6418 |               if (digit >= 0 && digit <= 9) {
6419 |                 value = value * 10 + digit;
6420 | 		if (++s < send) {
6421 |                   digit = *s - '0';
6422 |                   if (digit >= 0 && digit <= 9) {
6423 |                     value = value * 10 + digit;
6424 |                     if (++s < send) {
6425 |                       digit = *s - '0';
6426 |                       if (digit >= 0 && digit <= 9) {
6427 |                         value = value * 10 + digit;
6428 |                         if (++s < send) {
6429 |                           digit = *s - '0';
6430 |                           if (digit >= 0 && digit <= 9) {
6431 |                             value = value * 10 + digit;
6432 |                             if (++s < send) {
6433 |                               digit = *s - '0';
6434 |                               if (digit >= 0 && digit <= 9) {
6435 |                                 value = value * 10 + digit;
6436 |                                 if (++s < send) {
6437 |                                   digit = *s - '0';
6438 |                                   if (digit >= 0 && digit <= 9) {
6439 |                                     value = value * 10 + digit;
6440 |                                     if (++s < send) {
6441 |                                       /* Now got 9 digits, so need to check
6442 |                                          each time for overflow.  */
6443 |                                       digit = *s - '0';
6444 |                                       while (digit >= 0 && digit <= 9
6445 |                                              && (value < max_div_10
6446 |                                                  || (value == max_div_10
6447 |                                                      && digit <= max_mod_10))) {
6448 |                                         value = value * 10 + digit;
6449 |                                         if (++s < send)
6450 |                                           digit = *s - '0';
6451 |                                         else
6452 |                                           break;
6453 |                                       }
6454 |                                       if (digit >= 0 && digit <= 9
6455 |                                           && (s < send)) {
6456 |                                         /* value overflowed.
6457 |                                            skip the remaining digits, don't
6458 |                                            worry about setting *valuep.  */
6459 |                                         do {
6460 |                                           s++;
6461 |                                         } while (s < send && isDIGIT(*s));
6462 |                                         numtype |=
6463 |                                           IS_NUMBER_GREATER_THAN_UV_MAX;
6464 |                                         goto skip_value;
6465 |                                       }
6466 |                                     }
6467 |                                   }
6468 | 				}
6469 |                               }
6470 |                             }
6471 |                           }
6472 |                         }
6473 |                       }
6474 |                     }
6475 |                   }
6476 |                 }
6477 |               }
6478 |             }
6479 |           }
6480 | 	}
6481 |       }
6482 |     }
6483 |     numtype |= IS_NUMBER_IN_UV;
6484 |     if (valuep)
6485 |       *valuep = value;
6486 | 
6487 |   skip_value:
6488 |     if (GROK_NUMERIC_RADIX(&s, send)) {
6489 |       numtype |= IS_NUMBER_NOT_INT;
6490 |       while (s < send && isDIGIT(*s))  /* optional digits after the radix */
6491 |         s++;
6492 |     }
6493 |   }
6494 |   else if (GROK_NUMERIC_RADIX(&s, send)) {
6495 |     numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
6496 |     /* no digits before the radix means we need digits after it */
6497 |     if (s < send && isDIGIT(*s)) {
6498 |       do {
6499 |         s++;
6500 |       } while (s < send && isDIGIT(*s));
6501 |       if (valuep) {
6502 |         /* integer approximation is valid - it's 0.  */
6503 |         *valuep = 0;
6504 |       }
6505 |     }
6506 |     else
6507 |       return 0;
6508 |   } else if (*s == 'I' || *s == 'i') {
6509 |     s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6510 |     s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
6511 |     s++; if (s < send && (*s == 'I' || *s == 'i')) {
6512 |       s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6513 |       s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
6514 |       s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
6515 |       s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
6516 |       s++;
6517 |     }
6518 |     sawinf = 1;
6519 |   } else if (*s == 'N' || *s == 'n') {
6520 |     /* XXX TODO: There are signaling NaNs and quiet NaNs. */
6521 |     s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
6522 |     s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6523 |     s++;
6524 |     sawnan = 1;
6525 |   } else
6526 |     return 0;
6527 | 
6528 |   if (sawinf) {
6529 |     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
6530 |     numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
6531 |   } else if (sawnan) {
6532 |     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
6533 |     numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
6534 |   } else if (s < send) {
6535 |     /* we can have an optional exponent part */
6536 |     if (*s == 'e' || *s == 'E') {
6537 |       /* The only flag we keep is sign.  Blow away any "it's UV"  */
6538 |       numtype &= IS_NUMBER_NEG;
6539 |       numtype |= IS_NUMBER_NOT_INT;
6540 |       s++;
6541 |       if (s < send && (*s == '-' || *s == '+'))
6542 |         s++;
6543 |       if (s < send && isDIGIT(*s)) {
6544 |         do {
6545 |           s++;
6546 |         } while (s < send && isDIGIT(*s));
6547 |       }
6548 |       else
6549 |       return 0;
6550 |     }
6551 |   }
6552 |   while (s < send && isSPACE(*s))
6553 |     s++;
6554 |   if (s >= send)
6555 |     return numtype;
6556 |   if (len == 10 && memEQ(pv, "0 but true", 10)) {
6557 |     if (valuep)
6558 |       *valuep = 0;
6559 |     return IS_NUMBER_IN_UV;
6560 |   }
6561 |   return 0;
6562 | }
6563 | #endif
6564 | #endif
6565 | 
6566 | /*
6567 |  * The grok_* routines have been modified to use warn() instead of
6568 |  * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
6569 |  * which is why the stack variable has been renamed to 'xdigit'.
6570 |  */
6571 | 
6572 | #ifndef grok_bin
6573 | #if defined(NEED_grok_bin)
6574 | static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6575 | static
6576 | #else
6577 | extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6578 | #endif
6579 | 
6580 | #ifdef grok_bin
6581 | #  undef grok_bin
6582 | #endif
6583 | #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
6584 | #define Perl_grok_bin DPPP_(my_grok_bin)
6585 | 
6586 | #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
6587 | UV
6588 | DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6589 | {
6590 |     const char *s = start;
6591 |     STRLEN len = *len_p;
6592 |     UV value = 0;
6593 |     NV value_nv = 0;
6594 | 
6595 |     const UV max_div_2 = UV_MAX / 2;
6596 |     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6597 |     bool overflowed = FALSE;
6598 | 
6599 |     if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6600 |         /* strip off leading b or 0b.
6601 |            for compatibility silently suffer "b" and "0b" as valid binary
6602 |            numbers. */
6603 |         if (len >= 1) {
6604 |             if (s[0] == 'b') {
6605 |                 s++;
6606 |                 len--;
6607 |             }
6608 |             else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
6609 |                 s+=2;
6610 |                 len-=2;
6611 |             }
6612 |         }
6613 |     }
6614 | 
6615 |     for (; len-- && *s; s++) {
6616 |         char bit = *s;
6617 |         if (bit == '0' || bit == '1') {
6618 |             /* Write it in this wonky order with a goto to attempt to get the
6619 |                compiler to make the common case integer-only loop pretty tight.
6620 |                With gcc seems to be much straighter code than old scan_bin.  */
6621 |           redo:
6622 |             if (!overflowed) {
6623 |                 if (value <= max_div_2) {
6624 |                     value = (value << 1) | (bit - '0');
6625 |                     continue;
6626 |                 }
6627 |                 /* Bah. We're just overflowed.  */
6628 |                 warn("Integer overflow in binary number");
6629 |                 overflowed = TRUE;
6630 |                 value_nv = (NV) value;
6631 |             }
6632 |             value_nv *= 2.0;
6633 | 	    /* If an NV has not enough bits in its mantissa to
6634 | 	     * represent a UV this summing of small low-order numbers
6635 | 	     * is a waste of time (because the NV cannot preserve
6636 | 	     * the low-order bits anyway): we could just remember when
6637 | 	     * did we overflow and in the end just multiply value_nv by the
6638 | 	     * right amount. */
6639 |             value_nv += (NV)(bit - '0');
6640 |             continue;
6641 |         }
6642 |         if (bit == '_' && len && allow_underscores && (bit = s[1])
6643 |             && (bit == '0' || bit == '1'))
6644 | 	    {
6645 | 		--len;
6646 | 		++s;
6647 |                 goto redo;
6648 | 	    }
6649 |         if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6650 |             warn("Illegal binary digit '%c' ignored", *s);
6651 |         break;
6652 |     }
6653 | 
6654 |     if (   ( overflowed && value_nv > 4294967295.0)
6655 | #if UVSIZE > 4
6656 | 	|| (!overflowed && value > 0xffffffff  )
6657 | #endif
6658 | 	) {
6659 | 	warn("Binary number > 0b11111111111111111111111111111111 non-portable");
6660 |     }
6661 |     *len_p = s - start;
6662 |     if (!overflowed) {
6663 |         *flags = 0;
6664 |         return value;
6665 |     }
6666 |     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6667 |     if (result)
6668 |         *result = value_nv;
6669 |     return UV_MAX;
6670 | }
6671 | #endif
6672 | #endif
6673 | 
6674 | #ifndef grok_hex
6675 | #if defined(NEED_grok_hex)
6676 | static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6677 | static
6678 | #else
6679 | extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6680 | #endif
6681 | 
6682 | #ifdef grok_hex
6683 | #  undef grok_hex
6684 | #endif
6685 | #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
6686 | #define Perl_grok_hex DPPP_(my_grok_hex)
6687 | 
6688 | #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
6689 | UV
6690 | DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6691 | {
6692 |     const char *s = start;
6693 |     STRLEN len = *len_p;
6694 |     UV value = 0;
6695 |     NV value_nv = 0;
6696 | 
6697 |     const UV max_div_16 = UV_MAX / 16;
6698 |     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6699 |     bool overflowed = FALSE;
6700 |     const char *xdigit;
6701 | 
6702 |     if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6703 |         /* strip off leading x or 0x.
6704 |            for compatibility silently suffer "x" and "0x" as valid hex numbers.
6705 |         */
6706 |         if (len >= 1) {
6707 |             if (s[0] == 'x') {
6708 |                 s++;
6709 |                 len--;
6710 |             }
6711 |             else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
6712 |                 s+=2;
6713 |                 len-=2;
6714 |             }
6715 |         }
6716 |     }
6717 | 
6718 |     for (; len-- && *s; s++) {
6719 | 	xdigit = strchr((char *) PL_hexdigit, *s);
6720 |         if (xdigit) {
6721 |             /* Write it in this wonky order with a goto to attempt to get the
6722 |                compiler to make the common case integer-only loop pretty tight.
6723 |                With gcc seems to be much straighter code than old scan_hex.  */
6724 |           redo:
6725 |             if (!overflowed) {
6726 |                 if (value <= max_div_16) {
6727 |                     value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
6728 |                     continue;
6729 |                 }
6730 |                 warn("Integer overflow in hexadecimal number");
6731 |                 overflowed = TRUE;
6732 |                 value_nv = (NV) value;
6733 |             }
6734 |             value_nv *= 16.0;
6735 | 	    /* If an NV has not enough bits in its mantissa to
6736 | 	     * represent a UV this summing of small low-order numbers
6737 | 	     * is a waste of time (because the NV cannot preserve
6738 | 	     * the low-order bits anyway): we could just remember when
6739 | 	     * did we overflow and in the end just multiply value_nv by the
6740 | 	     * right amount of 16-tuples. */
6741 |             value_nv += (NV)((xdigit - PL_hexdigit) & 15);
6742 |             continue;
6743 |         }
6744 |         if (*s == '_' && len && allow_underscores && s[1]
6745 | 		&& (xdigit = strchr((char *) PL_hexdigit, s[1])))
6746 | 	    {
6747 | 		--len;
6748 | 		++s;
6749 |                 goto redo;
6750 | 	    }
6751 |         if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6752 |             warn("Illegal hexadecimal digit '%c' ignored", *s);
6753 |         break;
6754 |     }
6755 | 
6756 |     if (   ( overflowed && value_nv > 4294967295.0)
6757 | #if UVSIZE > 4
6758 | 	|| (!overflowed && value > 0xffffffff  )
6759 | #endif
6760 | 	) {
6761 | 	warn("Hexadecimal number > 0xffffffff non-portable");
6762 |     }
6763 |     *len_p = s - start;
6764 |     if (!overflowed) {
6765 |         *flags = 0;
6766 |         return value;
6767 |     }
6768 |     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6769 |     if (result)
6770 |         *result = value_nv;
6771 |     return UV_MAX;
6772 | }
6773 | #endif
6774 | #endif
6775 | 
6776 | #ifndef grok_oct
6777 | #if defined(NEED_grok_oct)
6778 | static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6779 | static
6780 | #else
6781 | extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6782 | #endif
6783 | 
6784 | #ifdef grok_oct
6785 | #  undef grok_oct
6786 | #endif
6787 | #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
6788 | #define Perl_grok_oct DPPP_(my_grok_oct)
6789 | 
6790 | #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
6791 | UV
6792 | DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6793 | {
6794 |     const char *s = start;
6795 |     STRLEN len = *len_p;
6796 |     UV value = 0;
6797 |     NV value_nv = 0;
6798 | 
6799 |     const UV max_div_8 = UV_MAX / 8;
6800 |     bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6801 |     bool overflowed = FALSE;
6802 | 
6803 |     for (; len-- && *s; s++) {
6804 |          /* gcc 2.95 optimiser not smart enough to figure that this subtraction
6805 |             out front allows slicker code.  */
6806 |         int digit = *s - '0';
6807 |         if (digit >= 0 && digit <= 7) {
6808 |             /* Write it in this wonky order with a goto to attempt to get the
6809 |                compiler to make the common case integer-only loop pretty tight.
6810 |             */
6811 |           redo:
6812 |             if (!overflowed) {
6813 |                 if (value <= max_div_8) {
6814 |                     value = (value << 3) | digit;
6815 |                     continue;
6816 |                 }
6817 |                 /* Bah. We're just overflowed.  */
6818 |                 warn("Integer overflow in octal number");
6819 |                 overflowed = TRUE;
6820 |                 value_nv = (NV) value;
6821 |             }
6822 |             value_nv *= 8.0;
6823 | 	    /* If an NV has not enough bits in its mantissa to
6824 | 	     * represent a UV this summing of small low-order numbers
6825 | 	     * is a waste of time (because the NV cannot preserve
6826 | 	     * the low-order bits anyway): we could just remember when
6827 | 	     * did we overflow and in the end just multiply value_nv by the
6828 | 	     * right amount of 8-tuples. */
6829 |             value_nv += (NV)digit;
6830 |             continue;
6831 |         }
6832 |         if (digit == ('_' - '0') && len && allow_underscores
6833 |             && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
6834 | 	    {
6835 | 		--len;
6836 | 		++s;
6837 |                 goto redo;
6838 | 	    }
6839 |         /* Allow \octal to work the DWIM way (that is, stop scanning
6840 |          * as soon as non-octal characters are seen, complain only iff
6841 |          * someone seems to want to use the digits eight and nine). */
6842 |         if (digit == 8 || digit == 9) {
6843 |             if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6844 |                 warn("Illegal octal digit '%c' ignored", *s);
6845 |         }
6846 |         break;
6847 |     }
6848 | 
6849 |     if (   ( overflowed && value_nv > 4294967295.0)
6850 | #if UVSIZE > 4
6851 | 	|| (!overflowed && value > 0xffffffff  )
6852 | #endif
6853 | 	) {
6854 | 	warn("Octal number > 037777777777 non-portable");
6855 |     }
6856 |     *len_p = s - start;
6857 |     if (!overflowed) {
6858 |         *flags = 0;
6859 |         return value;
6860 |     }
6861 |     *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6862 |     if (result)
6863 |         *result = value_nv;
6864 |     return UV_MAX;
6865 | }
6866 | #endif
6867 | #endif
6868 | 
6869 | #if !defined(my_snprintf)
6870 | #if defined(NEED_my_snprintf)
6871 | static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6872 | static
6873 | #else
6874 | extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6875 | #endif
6876 | 
6877 | #define my_snprintf DPPP_(my_my_snprintf)
6878 | #define Perl_my_snprintf DPPP_(my_my_snprintf)
6879 | 
6880 | #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
6881 | 
6882 | int
6883 | DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
6884 | {
6885 |     dTHX;
6886 |     int retval;
6887 |     va_list ap;
6888 |     va_start(ap, format);
6889 | #ifdef HAS_VSNPRINTF
6890 |     retval = vsnprintf(buffer, len, format, ap);
6891 | #else
6892 |     retval = vsprintf(buffer, format, ap);
6893 | #endif
6894 |     va_end(ap);
6895 |     if (retval < 0 || (len > 0 && (Size_t)retval >= len))
6896 | 	Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
6897 |     return retval;
6898 | }
6899 | 
6900 | #endif
6901 | #endif
6902 | 
6903 | #if !defined(my_sprintf)
6904 | #if defined(NEED_my_sprintf)
6905 | static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
6906 | static
6907 | #else
6908 | extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
6909 | #endif
6910 | 
6911 | #define my_sprintf DPPP_(my_my_sprintf)
6912 | #define Perl_my_sprintf DPPP_(my_my_sprintf)
6913 | 
6914 | #if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
6915 | 
6916 | int
6917 | DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
6918 | {
6919 |     va_list args;
6920 |     va_start(args, pat);
6921 |     vsprintf(buffer, pat, args);
6922 |     va_end(args);
6923 |     return strlen(buffer);
6924 | }
6925 | 
6926 | #endif
6927 | #endif
6928 | 
6929 | #ifdef NO_XSLOCKS
6930 | #  ifdef dJMPENV
6931 | #    define dXCPT             dJMPENV; int rEtV = 0
6932 | #    define XCPT_TRY_START    JMPENV_PUSH(rEtV); if (rEtV == 0)
6933 | #    define XCPT_TRY_END      JMPENV_POP;
6934 | #    define XCPT_CATCH        if (rEtV != 0)
6935 | #    define XCPT_RETHROW      JMPENV_JUMP(rEtV)
6936 | #  else
6937 | #    define dXCPT             Sigjmp_buf oldTOP; int rEtV = 0
6938 | #    define XCPT_TRY_START    Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
6939 | #    define XCPT_TRY_END      Copy(oldTOP, top_env, 1, Sigjmp_buf);
6940 | #    define XCPT_CATCH        if (rEtV != 0)
6941 | #    define XCPT_RETHROW      Siglongjmp(top_env, rEtV)
6942 | #  endif
6943 | #endif
6944 | 
6945 | #if !defined(my_strlcat)
6946 | #if defined(NEED_my_strlcat)
6947 | static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6948 | static
6949 | #else
6950 | extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6951 | #endif
6952 | 
6953 | #define my_strlcat DPPP_(my_my_strlcat)
6954 | #define Perl_my_strlcat DPPP_(my_my_strlcat)
6955 | 
6956 | #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
6957 | 
6958 | Size_t
6959 | DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
6960 | {
6961 |     Size_t used, length, copy;
6962 | 
6963 |     used = strlen(dst);
6964 |     length = strlen(src);
6965 |     if (size > 0 && used < size - 1) {
6966 |         copy = (length >= size - used) ? size - used - 1 : length;
6967 |         memcpy(dst + used, src, copy);
6968 |         dst[used + copy] = '\0';
6969 |     }
6970 |     return used + length;
6971 | }
6972 | #endif
6973 | #endif
6974 | 
6975 | #if !defined(my_strlcpy)
6976 | #if defined(NEED_my_strlcpy)
6977 | static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6978 | static
6979 | #else
6980 | extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6981 | #endif
6982 | 
6983 | #define my_strlcpy DPPP_(my_my_strlcpy)
6984 | #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
6985 | 
6986 | #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
6987 | 
6988 | Size_t
6989 | DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
6990 | {
6991 |     Size_t length, copy;
6992 | 
6993 |     length = strlen(src);
6994 |     if (size > 0) {
6995 |         copy = (length >= size) ? size - 1 : length;
6996 |         memcpy(dst, src, copy);
6997 |         dst[copy] = '\0';
6998 |     }
6999 |     return length;
7000 | }
7001 | 
7002 | #endif
7003 | #endif
7004 | #ifndef PERL_PV_ESCAPE_QUOTE
7005 | #  define PERL_PV_ESCAPE_QUOTE           0x0001
7006 | #endif
7007 | 
7008 | #ifndef PERL_PV_PRETTY_QUOTE
7009 | #  define PERL_PV_PRETTY_QUOTE           PERL_PV_ESCAPE_QUOTE
7010 | #endif
7011 | 
7012 | #ifndef PERL_PV_PRETTY_ELLIPSES
7013 | #  define PERL_PV_PRETTY_ELLIPSES        0x0002
7014 | #endif
7015 | 
7016 | #ifndef PERL_PV_PRETTY_LTGT
7017 | #  define PERL_PV_PRETTY_LTGT            0x0004
7018 | #endif
7019 | 
7020 | #ifndef PERL_PV_ESCAPE_FIRSTCHAR
7021 | #  define PERL_PV_ESCAPE_FIRSTCHAR       0x0008
7022 | #endif
7023 | 
7024 | #ifndef PERL_PV_ESCAPE_UNI
7025 | #  define PERL_PV_ESCAPE_UNI             0x0100
7026 | #endif
7027 | 
7028 | #ifndef PERL_PV_ESCAPE_UNI_DETECT
7029 | #  define PERL_PV_ESCAPE_UNI_DETECT      0x0200
7030 | #endif
7031 | 
7032 | #ifndef PERL_PV_ESCAPE_ALL
7033 | #  define PERL_PV_ESCAPE_ALL             0x1000
7034 | #endif
7035 | 
7036 | #ifndef PERL_PV_ESCAPE_NOBACKSLASH
7037 | #  define PERL_PV_ESCAPE_NOBACKSLASH     0x2000
7038 | #endif
7039 | 
7040 | #ifndef PERL_PV_ESCAPE_NOCLEAR
7041 | #  define PERL_PV_ESCAPE_NOCLEAR         0x4000
7042 | #endif
7043 | 
7044 | #ifndef PERL_PV_ESCAPE_RE
7045 | #  define PERL_PV_ESCAPE_RE              0x8000
7046 | #endif
7047 | 
7048 | #ifndef PERL_PV_PRETTY_NOCLEAR
7049 | #  define PERL_PV_PRETTY_NOCLEAR         PERL_PV_ESCAPE_NOCLEAR
7050 | #endif
7051 | #ifndef PERL_PV_PRETTY_DUMP
7052 | #  define PERL_PV_PRETTY_DUMP            PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
7053 | #endif
7054 | 
7055 | #ifndef PERL_PV_PRETTY_REGPROP
7056 | #  define PERL_PV_PRETTY_REGPROP         PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
7057 | #endif
7058 | 
7059 | /* Hint: pv_escape
7060 |  * Note that unicode functionality is only backported to
7061 |  * those perl versions that support it. For older perl
7062 |  * versions, the implementation will fall back to bytes.
7063 |  */
7064 | 
7065 | #ifndef pv_escape
7066 | #if defined(NEED_pv_escape)
7067 | static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
7068 | static
7069 | #else
7070 | extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
7071 | #endif
7072 | 
7073 | #ifdef pv_escape
7074 | #  undef pv_escape
7075 | #endif
7076 | #define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
7077 | #define Perl_pv_escape DPPP_(my_pv_escape)
7078 | 
7079 | #if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
7080 | 
7081 | char *
7082 | DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
7083 |   const STRLEN count, const STRLEN max,
7084 |   STRLEN * const escaped, const U32 flags)
7085 | {
7086 |     const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
7087 |     const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
7088 |     char octbuf[32] = "%123456789ABCDF";
7089 |     STRLEN wrote = 0;
7090 |     STRLEN chsize = 0;
7091 |     STRLEN readsize = 1;
7092 | #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7093 |     bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
7094 | #endif
7095 |     const char *pv  = str;
7096 |     const char * const end = pv + count;
7097 |     octbuf[0] = esc;
7098 | 
7099 |     if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
7100 | 	sv_setpvs(dsv, "");
7101 | 
7102 | #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7103 |     if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
7104 |         isuni = 1;
7105 | #endif
7106 | 
7107 |     for (; pv < end && (!max || wrote < max) ; pv += readsize) {
7108 |         const UV u =
7109 | #if defined(is_utf8_string) && defined(utf8_to_uvchr)
7110 | 		     isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
7111 | #endif
7112 | 			     (U8)*pv;
7113 |         const U8 c = (U8)u & 0xFF;
7114 | 
7115 |         if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
7116 |             if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
7117 |                 chsize = my_snprintf(octbuf, sizeof octbuf,
7118 |                                       "%"UVxf, u);
7119 |             else
7120 |                 chsize = my_snprintf(octbuf, sizeof octbuf,
7121 |                                       "%cx{%"UVxf"}", esc, u);
7122 |         } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
7123 |             chsize = 1;
7124 |         } else {
7125 |             if (c == dq || c == esc || !isPRINT(c)) {
7126 | 	        chsize = 2;
7127 |                 switch (c) {
7128 | 		case '\\' : /* fallthrough */
7129 | 		case '%'  : if (c == esc)
7130 | 		                octbuf[1] = esc;
7131 | 		            else
7132 | 		                chsize = 1;
7133 | 		            break;
7134 | 		case '\v' : octbuf[1] = 'v'; break;
7135 | 		case '\t' : octbuf[1] = 't'; break;
7136 | 		case '\r' : octbuf[1] = 'r'; break;
7137 | 		case '\n' : octbuf[1] = 'n'; break;
7138 | 		case '\f' : octbuf[1] = 'f'; break;
7139 |                 case '"'  : if (dq == '"')
7140 | 				octbuf[1] = '"';
7141 | 			    else
7142 | 				chsize = 1;
7143 | 			    break;
7144 | 		default:    chsize = my_snprintf(octbuf, sizeof octbuf,
7145 | 				pv < end && isDIGIT((U8)*(pv+readsize))
7146 | 				? "%c%03o" : "%c%o", esc, c);
7147 |                 }
7148 |             } else {
7149 |                 chsize = 1;
7150 |             }
7151 | 	}
7152 | 	if (max && wrote + chsize > max) {
7153 | 	    break;
7154 |         } else if (chsize > 1) {
7155 |             sv_catpvn(dsv, octbuf, chsize);
7156 |             wrote += chsize;
7157 | 	} else {
7158 | 	    char tmp[2];
7159 | 	    my_snprintf(tmp, sizeof tmp, "%c", c);
7160 |             sv_catpvn(dsv, tmp, 1);
7161 | 	    wrote++;
7162 | 	}
7163 |         if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
7164 |             break;
7165 |     }
7166 |     if (escaped != NULL)
7167 |         *escaped= pv - str;
7168 |     return SvPVX(dsv);
7169 | }
7170 | 
7171 | #endif
7172 | #endif
7173 | 
7174 | #ifndef pv_pretty
7175 | #if defined(NEED_pv_pretty)
7176 | static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
7177 | static
7178 | #else
7179 | extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
7180 | #endif
7181 | 
7182 | #ifdef pv_pretty
7183 | #  undef pv_pretty
7184 | #endif
7185 | #define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
7186 | #define Perl_pv_pretty DPPP_(my_pv_pretty)
7187 | 
7188 | #if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
7189 | 
7190 | char *
7191 | DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
7192 |   const STRLEN max, char const * const start_color, char const * const end_color,
7193 |   const U32 flags)
7194 | {
7195 |     const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
7196 |     STRLEN escaped;
7197 | 
7198 |     if (!(flags & PERL_PV_PRETTY_NOCLEAR))
7199 | 	sv_setpvs(dsv, "");
7200 | 
7201 |     if (dq == '"')
7202 |         sv_catpvs(dsv, "\"");
7203 |     else if (flags & PERL_PV_PRETTY_LTGT)
7204 |         sv_catpvs(dsv, "<");
7205 | 
7206 |     if (start_color != NULL)
7207 |         sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
7208 | 
7209 |     pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
7210 | 
7211 |     if (end_color != NULL)
7212 |         sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
7213 | 
7214 |     if (dq == '"')
7215 | 	sv_catpvs(dsv, "\"");
7216 |     else if (flags & PERL_PV_PRETTY_LTGT)
7217 |         sv_catpvs(dsv, ">");
7218 | 
7219 |     if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
7220 | 	sv_catpvs(dsv, "...");
7221 | 
7222 |     return SvPVX(dsv);
7223 | }
7224 | 
7225 | #endif
7226 | #endif
7227 | 
7228 | #ifndef pv_display
7229 | #if defined(NEED_pv_display)
7230 | static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7231 | static
7232 | #else
7233 | extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7234 | #endif
7235 | 
7236 | #ifdef pv_display
7237 | #  undef pv_display
7238 | #endif
7239 | #define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
7240 | #define Perl_pv_display DPPP_(my_pv_display)
7241 | 
7242 | #if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
7243 | 
7244 | char *
7245 | DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
7246 | {
7247 |     pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
7248 |     if (len > cur && pv[cur] == '\0')
7249 | 	sv_catpvs(dsv, "\\0");
7250 |     return SvPVX(dsv);
7251 | }
7252 | 
7253 | #endif
7254 | #endif
7255 | 
7256 | #endif /* _P_P_PORTABILITY_H_ */
7257 | 
7258 | /* End of File ppport.h */
7259 | 


--------------------------------------------------------------------------------