1N/A * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 1N/A * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others 1N/A * You may distribute under the terms of either the GNU General Public 1N/A * License or the Artistic License, as specified in the README file. 1N/A * "You see: Mr. Drogo, he married poor Miss Primula Brandybuck. She was 1N/A * our Mr. Bilbo's first cousin on the mother's side (her mother being the 1N/A * youngest of the Old Took's daughters); and Mr. Drogo was his second 1N/A * cousin. So Mr. Frodo is his first *and* second cousin, once removed 1N/A * either way, as the saying is, if you follow me." --the Gaffer 1N/A * To make incrementing use count easy PL_OpSlab is an I32 * 1N/A * To make inserting the link to slab PL_OpPtr is I32 ** 1N/A * So compute size in units of sizeof(I32 *) as that is how Pl_OpPtr increments 1N/A * Add an overhead for pointer to slab and round up as a number of pointers 1N/A /* We reserve the 0'th I32 sized chunk as a use count */ 1N/A /* Reduce size by the use count word, and by the size we need. 1N/A * Latter is to mimic the '-=' in the if() above 1N/A /* Allocation pointer starts at the top. 1N/A Theory: because we build leaves before trunk allocating at end 1N/A means that at run time access is cache friendly upward 1N/A /* Move the allocation pointer down */ 1N/A * In the following definition, the ", Nullop" is just to make the compiler 1N/A * think the expression is of the right type: croak actually does a Siglongjmp. 1N/A "Bareword \"%"SVf"\" not allowed while \"strict subs\" in use",
1N/A/* "register" allocation */ 1N/A /* complain about "my $_" etc etc */ 1N/A /* 1999-02-27 mjd@plover.com */ 1N/A /* The next block assumes the buffer is at least 205 chars 1N/A long. At present, it's always at least 256 chars. */ 1N/A /* Move everything else down one character */ 1N/A /* check for duplicate declaration */ 1N/A "Can't declare class for non-scalar %s in \"%s\"",
1N/A /* allocate a spare slot and store the name in that slot */ 1N/A/* find_threadsv is not reentrant */ 1N/A /* We currently only handle names of a single character */ 1N/A * Some magic variables used to be automagically initialised 1N/A * in gv_fetchpv. Those which are now per-thread magicals get 1N/A * initialised here instead. 1N/A /* XXX %! tied to Errno.pm needs to be added here. 1N/A * See gv_fetchpv(). */ 1N/A "find_threadsv: new SV %p for $%s%c\n",
1N/A#
endif /* USE_5005THREADS */ 1N/A /* COP* is not cleared by op_clear() so that we may track line 1N/A * numbers etc even after null() */ 1N/A#
endif /* USE_5005THREADS */ 1N/A /* not an OP_PADAV replacement */ 1N/A /* No GvIN_PAD_off(cGVOPo_gv) here, because other references 1N/A * may still exist on the pad */ 1N/A Even if op_clear does a pad_free for the target of the op, 1N/A pad_free doesn't actually remove the sv that exists in the pad; 1N/A instead it lives on. This results in that it could be reused as 1N/A a target later on when the pad was reallocated. 1N/A /* No GvIN_PAD_off here, because other references may still 1N/A * exist on the pad */ 1N/A /* we use the "SAFE" version of the PM_ macros here 1N/A * since sv_clean_all might release some PMOPs 1N/A * after PL_regex_padav has been cleared 1N/A * and the clearing of PL_regex_padav needs to 1N/A * happen before sv_clean_all 1N/A/* Contextualizers */ 1N/A /* establish postfix order */ 1N/A /* assumes no premature commitment */ 1N/A /* assumes no premature commitment */ 1N/A /* don't warn on optimised away booleans, eg 1N/A * use constant Foo, 5; Foo || print; */ 1N/A /* the constants 0 and 1 are permitted as they are 1N/A conventionally used as dummies in constructs like 1N/A 1 while some_condition_with_side_effects; */ 1N/A /* perl4's way of mixing documentation and code 1N/A (before the invention of POD) was based on a 1N/A trick to mix nroff and perl code. The trick was 1N/A built upon these three nroff macros being used in 1N/A void context. The pink camel has the details in 1N/A the script wrapman near page 319. */ 1N/A op_null(o);
/* don't execute or even remember it */ 1N/A /* all requires must return a boolean value */ 1N/A /* assumes no premature commitment */ 1N/A return o;
/* As if inside SASSIGN */ 1N/A /* all requires must return a boolean value */ 1N/A else {
/* lvalue subroutine call */ 1N/A /* Backward compatibility mode: */ 1N/A else {
/* Compile-time error message: */ 1N/A "panic: unexpected lvalue entersub " 1N/A "panic: unexpected lvalue entersub " 1N/A break;
/* Postpone until runtime */ 1N/A "Unexpected constant lvalue entersub " 1N/A /* Restore RV2CV to check lvalueness */ 1N/A /* grep, foreach, subcalls, refgen */ 1N/A ?
"non-lvalue subroutine call" 1N/A return o;
/* Treat \(@foo) like ordinary list. */ 1N/A /* Needed if maint gets patch 19588 1N/A return o;
/* Treat \(@foo) like ordinary list. */ 1N/A {
/* XXX DAPM 2002.08.25 tmp assert test */ 1N/A#
endif /* USE_5005THREADS */ 1N/A break;
/* mod()ing was handled by ck_return() */ 1N/A /* [20011101.069] File test operators interpret OPf_REF to mean that 1N/A their argument is a filehandle; thus \stat(".") should not set 1N/A /* An attrlist is either a simple OP_CONST or an OP_LIST with kids, 1N/A * where the first kid is OP_PUSHMARK and the remaining ones 1N/A * are OP_CONST. We need to push the OP_CONST values. 1N/A /* fake up C<use attributes $pkg,$rv,@attrs> */ 1N/A ENTER;
/* need to protect against side-effects of 'use' */ 1N/A /* Don't force the C<use> if we don't need it. */ 1N/A ;
/* already in %INC */ 1N/A /* Ensure that attributes.pm is loaded. */ 1N/A /* Need package name for method call. */ 1N/A /* Build up the real arg-list. */ 1N/A /* Fake up a method call to import */ 1N/A /* Combine the ops. */ 1N/A=notfor apidoc apply_attrs_string 1N/AAttempts to apply a list of attributes specified by the C<attrstr> and 1N/AC<len> arguments to the subroutine identified by the C<cv> argument which 1N/Ais expected to be associated with the package identified by the C<stashpv> 1N/Aargument (see L<attributes>). It gets this wrong, though, in that it 1N/Adoes not correctly identify the boundaries of the individual attribute 1N/Aspecifications within C<attrstr>. This is not really intended for the 1N/Apublic API, but has to be listed here for systems such as AIX which 1N/Aneed an explicit export list for symbols. (It's called from XS code 1N/Ain support of the C<ATTRS:> keyword from F<xsubpp>.) Patches to fix it 1N/Ato respect attribute syntax properly would be welcome. 1N/A /* check for C<my Dog $spot> when deciding package */ 1N/A/* [perl #17376]: this appears to be premature, and results in code such as 1N/A C< our(%x); > executing in list mode rather than void mode */ 1N/A ?
"@array" :
"%hash");
1N/A "Applying %s to %s will act on scalar(%s)",
1N/A /* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */ 1N/A/* XXX kept for BINCOMPAT only */ 1N/A /* If there were syntax errors, don't try to start a block */ 1N/A /* If there were syntax errors, don't try to close a block */ 1N/A#
endif /* USE_5005THREADS */ 1N/A /* Register with debugger */ 1N/A/* [perl #17376]: this appears to be premature, and results in code such as 1N/A C< our(%x); > executing in list mode rather than void mode */ 1N/A /* some heuristics to detect a potential error */ 1N/A if (
sigil && (*s ==
';' || *s ==
'=')) {
1N/A "Parentheses missing around \"%s\" list",
1N/A#
endif /* USE_5005THREADS */ 1N/A /* integerize op, unless it happens to be C<-foo>. 1N/A * XXX should pp_i_negate() do magic string negation instead? */ 1N/A /* XXX might want a ck_negate() for this */ 1N/A /* XXX what about the numeric ops? */ 1N/A goto nope;
/* Don't try to run w/ errors */ 1N/A return o;
/* Don't attempt to run with errors */ 1N/A o->
op_seq = 0;
/* needs to be revisited in peep() */ 1N/A/* List constructors */ 1N/A/* There are several snags with this code on EBCDIC: 1N/A 1. 0xFF is a legal UTF-EBCDIC byte (there are no illegal bytes). 1N/A 2. scan_const() in toke.c has encoded chars in native encoding which makes 1N/A ranges at least in EBCDIC 0..255 range the bottom odd. 1N/A for (j = 0; j < i; j++) {
1N/A /* see if we need more "t" chars */ 1N/A /* now see if we need more "r" chars */ 1N/A /* now see which range will peter our first, if either. */ 1N/A for (i = 0, j = 0; i <
256; i++) {
1N/A if (i <
128 && r[j] >=
128)
1N/A for (i = 0; i <
256; i++)
1N/A if (t[i] <
128 && r[j] >=
128)
1N/A /* link into pm list */ 1N/A /* establish postfix order */ 1N/A#
endif /* USE_5005THREADS */ 1N/A#
endif /* USE_5005THREADS */ 1N/A ;
/* Okay here, dangerous in newASSIGNOP */ 1N/A /* establish postfix order */ 1N/A /* Make copy of idop so we don't free it twice */ 1N/A /* Fake up a method call to VERSION */ 1N/A /* Make copy of idop so we don't free it twice */ 1N/A /* Fake up the BEGIN {}, which does its thing immediately. */ 1N/A /* The "did you use incorrect case?" warning used to be here. 1N/A * The problem is that on case-insensitive filesystems one 1N/A * might get false positives for "use" (and "require"): 1N/A * "use Strict" or "require CARP" will work. This causes 1N/A * portability problems for the script: in case-strict 1N/A * filesystems the script will stop working. 1N/A * The "incorrect case" warning checked whether "use Foo" 1N/A * imported "Foo" to your namespace, but that is wrong, too: 1N/A * there is no requirement nor promise in the language that 1N/A * a Foo.pm should or would contain anything in package "Foo". 1N/A * There is very little Configure-wise that can be done, either: 1N/A * the case-sensitivity of the build filesystem of Perl does not 1N/A * help in guessing the case-sensitivity of the runtime environment. 1N/A=head1 Embedding Functions 1N/A=for apidoc load_module 1N/ALoads the module whose name is pointed to by the string part of name. 1N/ANote that the actual module name, not its filename, should be given. 1N/APERL_LOADMOD_DENY, PERL_LOADMOD_NOIMPORT, or PERL_LOADMOD_IMPORT_OPS 1N/A(or 0 for no flags). ver, if specified, provides version semantics 1N/Asimilar to C<use Foo::Bar VERSION>. The optional trailing SV* 1N/Aarguments can be used to specify arguments to the module's import() 1N/Amethod, similar to C<use Foo::Bar VERSION LIST>. 1N/A yyerror(
"Assignment to both a list and a scalar");
1N/A /* optimise C<my @x = ()> to C<my @x>, and likewise for hashes */ 1N/A /* PL_generation sorcery: 1N/A * an assignment like ($a,$b) = ($c,$d) is easier than 1N/A * ($a,$b) = ($c,$a), since there is no need for temporary vars. 1N/A * To detect whether there are common vars, the global var 1N/A * PL_generation is incremented for each assign op we compile. 1N/A * Then, while compiling the assign op, we run through all the 1N/A * variables on both sides of the assignment, setting a spare slot 1N/A * in each of them to PL_generation. If any of them already have 1N/A * that value, we know we've got commonality. We could use a 1N/A * single bit marker, but then we'd have to make 2 passes, first 1N/A * to clear the flag, then to test and set it. To find somewhere 1N/A * to store these values, evil chicanery is done with SvCUR(). 1N/A /* "I don't know and I don't care." */ 1N/A if (
type ==
OP_XOR)
/* Not short circuit, but here by precedence. */ 1N/A /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */ 1N/A "Value of %s%s can be \"0\"; test with defined()",
1N/A ?
" construct" :
"() operator"));
1N/A /* establish postfix order */ 1N/A /* establish postfix order */ 1N/A return block;
/* do {} while 0 does once */ 1N/A /* if block is null, the next append_elem() would put UNSTACK, a scalar 1N/A * op, in listop. This is wrong. [perl #27024] */ 1N/A return Nullop;
/* listop already freed by new_logop */ 1N/A /* Basically turn for($x..$y) into the same as for($x,$y), but we 1N/A * set the STACKED flag to indicate that these values are to be 1N/A * treated as min/max values by 'pp_iterinit'. 1N/A /* for my $x () sets OPpLVAL_INTRO; 1N/A * for our $x () sets OPpOUR_INTRO; both only used by Deparse.pm */ 1N/A /* "last()" means "last" */ 1N/A /* Check whether it's going to be a goto &function */ 1N/AClear out all the active components of a CV. This can happen either 1N/Aby an explicit C<undef &foo>, or by the reference count going to zero. 1N/AIn the former case, we keep the CvOUTSIDE pointer, so that any anonymous 1N/Achildren can still follow the full lexical scope chain. 1N/A#
endif /* USE_5005THREADS */ 1N/A /* for XSUBs CvFILE point directly to static memory; __FILE__ */ 1N/A#
endif /* USE_5005THREADS */ 1N/A /* remove CvOUTSIDE unless this is an undef rather than a free */ 1N/A /* delete all flags except WEAKOUTSIDE */ 1N/A=head1 Optree Manipulation Functions 1N/A=for apidoc cv_const_sv 1N/AIf C<cv> is a constant sub eligible for inlining. returns the constant 1N/Avalue returned by the sub. Otherwise, returns NULL. 1N/AConstant subs can be created with C<newCONSTSUB> or as described in 1N/AL<perlsub/"Constant Functions">. 1N/A /* We get here only from cv_clone2() while creating a closure. 1N/A Copy the const value here instead of in cv_clone2 so that 1N/A SvREADONLY_on doesn't lead to problems when leaving 1N/A maximum a prototype before. */ 1N/A /* if the subroutine doesn't exist and wasn't pre-declared 1N/A * with a prototype, assume it will be AUTOLOADed, 1N/A * skipping the prototype check 1N/A /* already defined (or promised)? */ 1N/A /* might have had built-in attrs applied */ 1N/A /* just a "sub foo;" when &foo is already defined */ 1N/A /* ahem, death to those who redefine active sort subs */ 1N/A :
"Subroutine %s redefined",
name);
1N/A /* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs> 1N/A * before we clobber PL_compcv. 1N/A /* Might have had built-in attributes applied -- propagate them. */ 1N/A /* possibly about to re-define existing subr -- ignore old cv */ 1N/A if (
cv) {
/* must reuse cv if autoloaded */ 1N/A /* got here with just attrs -- work done, so bug out */ 1N/A /* transfer PL_compcv to cv */ 1N/A /* inner references to PL_compcv must be fixed up ... */ 1N/A /* ... before we throw it away */ 1N/A#
endif /* USE_5005THREADS */ 1N/A "BEGIN not safe after errors--compilation aborted";
1N/A /* force display of errors found but not reported */ 1N/A /* This makes sub {}; work as expected. */ 1N/A /* now that optimizer has done its work, adjust pad values */ 1N/A if (*s !=
'B' && *s !=
'E' && *s !=
'C' && *s !=
'I')
1N/A/* XXX unsafe for threads if eval_owner isn't held */ 1N/A=for apidoc newCONSTSUB 1N/ACreates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is 1N/Aeligible for inlining at compile-time. 1N/AUsed by C<xsubpp> to hook up XSUBs as Perl subs. 1N/A /* just a cached method */ 1N/A /* already defined (or promised) */ 1N/A :
"Subroutine %s redefined" 1N/A if (
cv)
/* must reuse cv if autoloaded */ 1N/A#
endif /* USE_5005THREADS */ 1N/A an external constant string */ 1N/A if (*s !=
'B' && *s !=
'E' && *s !=
'C' && *s !=
'I')
1N/A "Using an array as a reference is deprecated");
1N/A "Using a hash as a reference is deprecated");
1N/A/* Check routines. */ 1N/A "Possible precedence problem on bitwise %c operator",
1N/A /* establish postfix order */ 1N/A /* Is it a constant from cv_const_sv()? */ 1N/A "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
1N/A * This is a little tricky. We only want to add the symbol if we 1N/A * didn't add it in the lexer. Otherwise we get duplicate strict 1N/A * warnings. But if we didn't add it in the lexer, we must at 1N/A * least pretend like we wanted to add it even if it existed before, 1N/A * or we get possible typo warnings. OPpCONST_ENTERED says 1N/A * whether the lexer already added THIS instance of this symbol. 1N/A /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */ 1N/A /* list seen where single (scalar) arg expected? */ 1N/A "Useless use of %s with no values",
1N/A "Array @%s missing the @ in argument %"IVdf" of %s()",
1N/A "Hash %%%s missing the %% in argument %"IVdf" of %s()",
1N/A /* neophyte patrol: open(<FH>), close(<FH>) etc. */ 1N/A /* is this op a FH constructor? */ 1N/A /* Set a flag to tell rv2gv to vivify 1N/A * need to "prove" flag does not mean something 1N/A * else already - NI-S 1999/05/07 1N/A /*XXX DAPM 2002.08.25 tmp assert test */ 1N/A /* SvCUR of a pad namesv can't be trusted 1N/A * (see PL_generation), so calc its length 1N/A /* packagevar $a[] or $h{} */ 1N/A /* lexicalvar $a[] or $h{} */ 1N/A /* XXX this can be tightened up and made more failsafe. */ 1N/A#
endif /* PERL_EXTERNAL_GLOB */ 1N/A /* XXX length optimization goes here */ 1N/A /* This is needed for 1N/A if (defined %stash::) 1N/A to work. Do not break Tk. 1N/A break;
/* Globals via GV can be undef */ 1N/A "defined(@array) is deprecated");
1N/A "\t(Maybe you should just omit the defined()?)\n");
1N/A /* This is needed for 1N/A if (defined %stash::) 1N/A to work. Do not break Tk. 1N/A break;
/* Globals via GV can be undef */ 1N/A "defined(%%hash) is deprecated");
1N/A "\t(Maybe you should just omit the defined()?)\n");
1N/A /* has a disposable target? */ 1N/A /* Cannot steal the second time! */ 1N/A /* Can just relocate the target. */ 1N/A /* Now we do not need PADSV and SASSIGN. */ 1N/A /* optimise C<my $x = undef> to C<my $x> */ 1N/A /* In case of three-arg dup open remove strictness 1N/A * from the last arg if it is a bareword. */ 1N/A if (*s ==
':' && s[
1] ==
':') {
1N/A /* handle override, if any */ 1N/A#
endif /* USE_5005THREADS */ 1N/A /* don't descend into loops */ 1N/A /* provide list context for arguments */ 1N/A k =
kid;
/* remember this node*/ 1N/A "Use of /g modifier is meaningless in split");
1N/A "/%s/ should probably be written as \"%s\"",
1N/A arg ==
1 ?
"block or sub {}" :
"sub {}",
1N/A /* '*' allows any scalar type, including bareword */ 1N/A /* accidental subroutine, revert to bareword */ 1N/A while (*--p !=
'[');
1N/A/* A peephole optimizer. We visit the ops in the order they're to execute. */ 1N/A /* The special value -1 is used by the B::C compiler backend to indicate 1N/A * that an op is statically defined and should not be freed */ 1N/A /* Relocate sv to the pad for thread safety. 1N/A * Despite being a "constant", the SV is written to, 1N/A * for reference counts, sv_upgrade() etc. */ 1N/A /* If op_sv is already a PADTMP then it is being used by 1N/A * some pad, so make a copy. */ 1N/A /* XXX I don't know how this isn't readonly already. */ 1N/A /* assert(PL_opargs[o->op_type] & OA_TARGLEX); */ 1N/A break;
/* Scalar stub must produce undef. List stub is noop */ 1N/A /* XXX: We avoid setting op_seq here to prevent later calls 1N/A to peep() from mistakenly concluding that optimisation 1N/A has already occurred. This doesn't fix the real problem, 1N/A though (See 20010220.007). AMS 20010719 */ 1N/A /* XXX could check prototype here instead of just carping */ 1N/A "%"SVf"() called too early to check prototype",
1N/A /* Turn "$a .= <FH>" into an OP_RCATLINE. AMS 20010917 */ 1N/A "Statement unlikely to be reached");
1N/A "\t(Maybe you meant system() when you said exec()?)\n");
1N/A /* Make the CONST have a shared SV */ 1N/A /* I bet there's always a pushmark... */ 1N/A /* hmmm, no optimization if list contains only one key. */ 1N/A /* Again guessing that the pushmark can be jumped over.... */ 1N/A /* Check that the key list contains only constants. */ 1N/A "in variable %s of type %s",
1N/A /* make @a = sort @a act in-place */ 1N/A /* will point to RV2AV or PADAV op on LHS/RHS of assign */ 1N/A /* check that RHS of sort is a single plain array */ 1N/A /* o2 follows the chain of op_nexts through the LHS of the 1N/A * assign (if any) to the aassign op itself */ 1N/A /* check that the sort is the first arg on RHS of assign */ 1N/A /* check the array is the same on both sides */ 1N/A /* transfer MODishness etc from LHS arg to RHS arg */ 1N/A /* excise push->gv->rv2av->null->aassign */ 1N/A/* Efficient sub that returns a constant scalar value. */