/* pp_hot.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* Then he heard Merry change the note, and up went the Horn-cry of Buckland,
* shaking the air.
*
* Awake! Awake! Fear, Fire, Foes! Awake!
* Fire, Foes! Awake!
*/
#include "EXTERN.h"
#define PERL_IN_PP_HOT_C
#include "perl.h"
/* Hot code. */
#ifdef USE_5005THREADS
#endif /* USE_5005THREADS */
{
dSP;
}
{
TAINT_NOT; /* Each statement is presumed innocent */
return NORMAL;
}
{
dSP;
else
}
{
return NORMAL;
}
{
return NORMAL;
}
{
return NORMAL;
}
{
}
{
dSP;
}
{
dSP;
else {
--SP;
}
}
{
}
}
{
dSP;
else
}
{
TAINT_NOT; /* Each statement is presumed innocent */
return NORMAL;
}
{
{
char* lpv;
bool lbyte;
}
if (!lbyte)
else
}
else { /* TARG == left */
if (SvGMAGICAL(left))
if (IN_BYTES)
}
#if defined(PERL_Y2KWARN)
{
"about to append an integer to '19'");
}
}
#endif
if (lbyte)
else {
if (!rcopied)
}
}
}
}
{
}
}
}
{
tryAMAGICunTARGET(iter, 0);
else {
dSP;
pp_rv2gv();
}
}
return do_readline();
}
{
#ifndef NV_PRESERVES_UV
SP--;
}
#endif
#ifdef PERL_PRESERVE_IVUV
/* Unless the left argument is integer in range we are going
to have to use NV maths. Hence only attempt to coerce the
right argument if we know the left is integer. */
/* Casting IV to UV before comparison isn't going to matter
on 2s complement. On 1s complement or sign&magnitude
(if we have any of them) it could to make negative zero
differ from normal zero. As I understand it. (Need to
check - is negative zero implementation defined behaviour
anyway?). NWC */
}
{ /* ## Mixed IV,UV ## */
/* == is commutative so doesn't matter which is left or right */
if (auvok) {
/* top of stack (b) is the iv */
} else {
}
if (iv < 0) {
/* As uv is a UV, it's >0, so it cannot be == */
}
/* we know iv is >= 0 */
}
}
}
#endif
{
}
}
{
dSP;
{
}
else /* Do all the PERL_PRESERVE_IVUV conditionals in sv_inc */
return NORMAL;
}
{
dSP;
else {
--SP;
}
}
{
#ifdef PERL_PRESERVE_IVUV
/* We must see if we can perform the addition with integers if possible,
as the integer code detects overflow while the NV code doesn't.
If either argument hasn't had a numeric conversion yet attempt to get
the IV. It's important to do this now, rather than just assuming that
it's not IOK as a PV of "9223372036854775806" may not take well to NV
addition, and an SV which is NOK, NV=6.0 ought to be coerced to
integer in case the second argument is IV=9223372036854775806
We can (now) rely on sv_2iv to do the right thing, only setting the
public IOK flag if the value in the NV (or PV) slot is truly integer.
A side effect is that this also aggressively prefers integer maths over
fp maths for integer values.
How to detect overflow?
C 99 section 6.2.6.1 says
The range of nonnegative values of a signed integer type is a subrange
of the corresponding unsigned integer type, and the representation of
the same value in each type is the same. A computation involving
unsigned operands can never overflow, because a result that cannot be
represented by the resulting unsigned integer type is reduced modulo
the number that is one greater than the largest value that can be
represented by the resulting type.
(the 9th paragraph)
which I read as "unsigned ints wrap."
signed integer overflow seems to be classed as "exception condition"
If an exceptional condition occurs during the evaluation of an
expression (that is, if the result is not mathematically defined or not
in the range of representable values for its type), the behavior is
undefined.
(6.5, the 5th paragraph)
I had assumed that on 2s complement machines signed arithmetic would
wrap, hence coded pp_add and pp_subtract on the assumption that
everything perl builds on would be happy. After much wailing and
gnashing of teeth it would seem that irix64 knows its ANSI spec well,
knows that it doesn't need to, and doesn't. Bah. Anyway, the all-
unsigned code below is actually shorter than the old code. :-)
*/
/* Unless the left argument is integer in range we are going to have to
use NV maths. Hence only attempt to coerce the right argument if
we know the left is integer. */
bool a_valid = 0;
if (!useleft) {
auv = 0;
/* left operand is undef, treat as zero. + 0 is identity,
Could SETi or SETu right now, but space optimise by not adding
lots of code to speed up what is probably a rarish case. */
} else {
/* Left operand is defined, so is it IV? */
else {
if (aiv >= 0) {
} else { /* 2s complement assumption for IV_MIN */
}
}
a_valid = 1;
}
}
if (a_valid) {
bool result_good = 0;
if (buvok)
else {
if (biv >= 0) {
buvok = 1;
} else
}
/* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
else "IV" now, independent of how it came in.
if a, b represents positive, A, B negative, a maps to -A etc
a + b => (a + b)
A + b => -(a - b)
a + B => (a - b)
A + B => -(a + b)
all UV maths. negate result if A negative.
add if signs same, subtract if signs differ. */
/* Signs differ. */
/* Must get smaller */
result_good = 1;
} else {
/* result really should be -(auv-buv). as its negation
of true value, need to swap our result flag */
result_good = 1;
}
}
} else {
/* Signs same */
result_good = 1;
}
if (result_good) {
SP--;
if (auvok)
else {
/* Negate result */
else {
/* result valid, but out of range for IV. */
}
}
} /* Overflow, drop through to NVs. */
}
}
#endif
{
if (!useleft) {
/* left operand is undef, treat as zero. + 0.0 is identity. */
}
}
}
{
dSP;
}
{
MARK++;
}
{
dSP;
#ifdef DEBUGGING
/*
* We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
* will be enough to hold an OP*.
*/
#else
#endif
}
/* Oversized hot code. */
{
else
gv = PL_defoutgv;
{
/* If using default handle then we need to make space to
* pass object as 1st arg, so move other args up ...
*/
++MARK;
++SP;
}
}
goto had_magic;
goto just_say_no;
}
}
goto just_say_no;
}
else {
MARK++;
break;
MARK++;
MARK--;
break;
}
}
}
}
else {
break;
MARK++;
}
}
goto just_say_no;
else {
goto just_say_no;
goto just_say_no;
}
}
PUSHs(&PL_sv_undef);
}
{
}
else if (LVRET) {
}
}
else {
}
else if (LVRET) {
" scalar context");
}
}
else {
char *sym;
if (SvGMAGICAL(sv)) {
goto wasref;
}
if (ckWARN(WARN_UNINITIALIZED))
(void)POPs;
}
}
{
if (!gv
{
}
}
else {
}
}
else {
}
}
else if (LVRET) {
" scalar context");
}
}
}
(void)POPs; /* XXXX May be optimized away? */
if (SvRMAGICAL(av)) {
U32 i;
/* See note in pp_helem, and bug id #27839 */
: &PL_sv_undef;
}
}
else {
}
}
}
}
{
}
else if (LVRET) {
}
}
else {
}
else if (LVRET) {
" scalar context");
}
}
else {
char *sym;
if (SvGMAGICAL(sv)) {
goto wasref;
}
if (ckWARN(WARN_UNINITIALIZED))
SP--;
}
}
{
if (!gv
{
}
}
else {
}
}
else {
}
}
else if (LVRET) {
" scalar context");
}
}
}
return do_kv();
}
}
}
STATIC int
{
I32 i;
/* Skip PUSHMARK and each element already assigned to. */
for (i = lelem - firstlelem; i > 0; i--) {
}
return 0;
/* pseudohash */
/* Avoid a memory leak when avhv_store_ent dies. */
tmpstr = sv_newmortal();
(void)SvREFCNT_inc(tmpstr);
relem += 2;
}
}
return 1;
return 2;
}
STATIC void
{
if (*relem) {
if (relem == firstrelem &&
{
"Reference found where even-sized list expected");
}
else
"Odd number of elements in hash assignment");
}
/* pseudohash */
tmpstr = sv_newmortal();
(void)SvREFCNT_inc(tmpstr);
}
else {
if (SvSMAGICAL(tmpstr))
if (!didstore)
}
}
}
}
{
dSP;
I32 i;
int magic;
int duplicates = 0;
/* If there's a common identifier on both sides we have to take
* special care that assigning the identifier on the left doesn't
* clobber a value on the right that's used later in the list.
*/
/*SUPPRESS 560*/
TAINT_NOT; /* Each item is independent */
}
}
}
relem = firstrelem;
lelem = firstlelem;
TAINT_NOT; /* Each item stands on its own, taintwise. */
case SVt_PVAV:
{
case 0:
goto normal_array;
case 1:
}
break;
}
i = 0;
if (magic) {
if (SvSMAGICAL(sv))
if (!didstore)
sv_2mortal(sv);
}
}
break;
case SVt_PVHV: { /* normal hash */
if (*relem)
else
if (*relem)
/* key overwrites an existing entry */
duplicates += 2;
if (magic) {
if (SvSMAGICAL(tmpstr))
if (!didstore)
}
}
relem++;
}
}
break;
default:
if (SvIMMORTAL(sv)) {
relem++;
break;
}
}
else
SvSETMAGIC(sv);
break;
}
}
if (PL_delaymagic & ~DM_DELAY) {
if (PL_delaymagic & DM_UID) {
#ifdef HAS_SETRESUID
(Uid_t)-1);
#else
# ifdef HAS_SETREUID
# else
# ifdef HAS_SETRUID
PL_delaymagic &= ~DM_RUID;
}
# endif /* HAS_SETRUID */
# ifdef HAS_SETEUID
PL_delaymagic &= ~DM_EUID;
}
# endif /* HAS_SETEUID */
if (PL_delaymagic & DM_UID) {
(void)PerlProc_setuid(PL_uid);
}
# endif /* HAS_SETREUID */
#endif /* HAS_SETRESUID */
PL_uid = PerlProc_getuid();
PL_euid = PerlProc_geteuid();
}
if (PL_delaymagic & DM_GID) {
#ifdef HAS_SETRESGID
(Gid_t)-1);
#else
# ifdef HAS_SETREGID
# else
# ifdef HAS_SETRGID
PL_delaymagic &= ~DM_RGID;
}
# endif /* HAS_SETRGID */
# ifdef HAS_SETEGID
PL_delaymagic &= ~DM_EGID;
}
# endif /* HAS_SETEGID */
if (PL_delaymagic & DM_GID) {
(void)PerlProc_setgid(PL_gid);
}
# endif /* HAS_SETREGID */
#endif /* HAS_SETRESGID */
PL_gid = PerlProc_getgid();
PL_egid = PerlProc_getegid();
}
}
PL_delaymagic = 0;
SP = firstrelem;
}
else {
if (ary)
else if (hash) {
if (duplicates) {
/* Removes from the stack the entries which ended up as
* duplicated keys in the hash (fix for [perl #24380]) */
lastrelem -= duplicates;
}
}
else
}
}
{
dSP;
}
{
register char *t;
register char *s;
char *strend;
bool rxtainted;
else {
}
PUTBACK; /* EVAL blocks need stack_sp. */
if (!s)
/* PMdf_USED is set after a ?? matches once */
}
/* empty pattern special-cased to use last successful pattern if possible */
}
goto failure;
truebase = t = s;
/* XXXX What part of this is needed with true \G-support? */
}
update_minmatch = 0;
}
}
}
r_flags |= REXEC_SCREAM;
}
goto nope;
if (update_minmatch++)
}
if (!s)
goto nope;
&& !PL_sawampersand
&& (r_flags & REXEC_SCREAM)))
goto yup;
}
{
goto gotcha;
}
else
goto ret_no;
/*NOTREACHED*/
if (rxtainted)
i = 1;
else
i = 0;
SPAGAIN; /* EVAL blocks could move the stack. */
EXTEND_MORTAL(nparens + i);
for (i = !i; i <= nparens; i++) {
PUSHs(sv_newmortal());
/*SUPPRESS 560*/
}
}
if (global) {
if (!mg) {
}
else
}
}
PUTBACK; /* EVAL blocks may use stack */
goto play_it_again;
}
else if (!nparens)
}
else {
if (global) {
if (!mg) {
}
else
}
}
}
yup: /* Confirmed by INTUIT */
if (rxtainted)
if (RX_MATCH_COPIED(rx))
if (global) {
if (RX_MATCH_UTF8(rx)) {
}
else {
}
goto gotcha;
}
if (PL_sawampersand) {
}
}
nope:
if (mg)
}
}
}
OP *
{
}
}
if (io) {
if (!fp) {
goto have_fp;
}
}
if (!fp) { /* Note: fp != IoIFP(io) */
}
}
}
SP--;
}
}
if (!fp) {
"glob failed (can't start child: %s)",
else
}
/* undef TARG, and push that undefined value */
if (type != OP_RCATLINE) {
}
}
}
offset = 0;
}
}
}
else {
offset = 0;
}
/* This should not be marked tainted if the fp is marked clean */
TAINT; \
SvTAINTED_on(sv); \
}
/* delay EOF state for a snarfed empty file */
for (;;) {
|| PerlIO_error(fp)))
{
if (fp)
continue;
}
"glob failed (child exited with status %d%s)",
(int)(STATUS_CURRENT >> 8),
}
}
if (type != OP_RCATLINE) {
}
}
}
SvSETMAGIC(sv);
char *tmps;
*tmps = '\0';
}
}
break;
(void)POPs; /* Unmatched wildcard? Chuck it... */
continue;
}
U8 *f;
/* Emulate :encoding(utf8) warning in the same case. */
"utf8 \"\\x%02X\" does not map to Unicode",
}
}
continue;
}
/* try to reclaim a bit of scalar space (only on 1st alloc) */
else
}
}
}
{
dSP;
if (gimme == -1) {
if (cxstack_ix >= 0)
else
}
}
{
dSP;
/* does the element we're localizing already exist? */
/* can we determine whether it exists? */
( !SvRMAGICAL(hv)
/* Try to preserve the existenceness of a tied hash
* element by using EXISTS and DELETE if possible.
* Fallback to FETCH and STORE otherwise */
)
}
}
}
else {
}
if (lval) {
if (!defer) {
}
lv = sv_newmortal();
}
else {
if (!preeminent) {
} else
}
}
}
/* This makes C<local $tied{foo} = $tied{foo}> possible.
* Pushing the magical RHS on to the stack is useless, since
* that magic is soon destined to be misled by the local(),
* and thus the later pp_sassign() will fail to mg_get() the
* old value. This should also cure problems with delayed
* mg_get()s. GSAR 98-07-03 */
}
{
dSP;
}
if (gimme == -1) {
if (cxstack_ix >= 0)
else
}
else
} else {
*MARK = &PL_sv_undef;
}
}
/* in case LEAVE wipes old return values */
TAINT_NOT; /* Each item is independent */
}
}
}
}
{
dSP;
/* iterate ($min .. $max) */
/* string increment */
#ifndef USE_5005THREADS /* don't risk potential race */
/* safe to reuse old SV */
}
else
#endif
{
/* we need a fresh SV every time so that loop body sees a
* completely new SV for closures/references to work as
* they used to */
}
else
}
}
/* integer increment */
#ifndef USE_5005THREADS /* don't risk potential race */
/* safe to reuse old SV */
}
else
#endif
{
/* we need a fresh SV every time so that loop body sees a
* completely new SV for closures/references to work as they
* used to */
}
}
/* iterate array */
if (svp)
else
}
else {
}
}
if (sv)
SvTEMP_off(sv);
else
sv = &PL_sv_undef;
}
if (lv)
else {
}
}
}
{
register char *s;
char *strend;
register char *m;
char *c;
register char *d;
register I32 i;
bool once;
bool rxtainted;
char *orig;
int force_on_match = 0;
/* known replacement string? */
else {
}
if (SvREADONLY(TARG)
force_on_match = 1;
if (PL_tainted)
rxtainted |= 2;
if (!pm || !s)
position, once with zero-length,
second time with non-zero. */
}
? REXEC_COPY_STR : 0;
r_flags |= REXEC_SCREAM;
}
orig = m = s;
if (!s)
goto nope;
/* How to do it in subst? */
/* if ( (rx->reganch & ROPT_CHECK_ALL)
&& !PL_sawampersand
&& ((rx->reganch & ROPT_NOSCAN)
|| !((rx->reganch & RE_INTUIT_TAIL)
&& (r_flags & REXEC_SCREAM))))
goto yup;
*/
}
/* only replace once? */
/* known replacement string? */
if (dstr) {
/* replacement needing upgrading? */
nsv = sv_newmortal();
if (PL_encoding)
else
}
else {
}
}
else {
c = Nullch;
}
/* can do inplace substitution? */
r_flags | REXEC_CHECKED))
{
}
if (force_on_match) {
force_on_match = 0;
goto force_it;
}
d = s;
if (once) {
s = orig;
if (m - s > strend - d) { /* faster to shorten from end */
if (clen) {
m += clen;
}
i = strend - d;
if (i > 0) {
Move(d, m, i, char);
m += i;
}
*m = '\0';
}
/*SUPPRESS 560*/
else if ((i = m - s)) { /* faster from front */
d -= clen;
m = d;
s += i;
while (i--)
*--d = *--s;
if (clen)
}
else if (clen) {
d -= clen;
}
else {
}
}
else {
do {
/*SUPPRESS 560*/
if ((i = m - s)) {
if (s != d)
Move(s, d, i, char);
d += i;
}
if (clen) {
d += clen;
}
/* don't match same null twice */
if (s != d) {
i = strend - s;
}
}
(void)SvPOK_only_UTF8(TARG);
if (SvSMAGICAL(TARG)) {
}
if (doutf8)
}
r_flags | REXEC_CHECKED))
{
if (force_on_match) {
force_on_match = 0;
goto force_it;
}
if (!c) {
}
do {
m = s;
s = orig;
s = orig + (m - s);
}
else
if (clen)
if (once)
break;
else
(void)SvPOK_only(TARG);
if (doutf8)
}
goto ret_no;
nope:
}
{
dSP;
++*PL_markstack_ptr;
LEAVE; /* exit inner scope */
/* All done yet? */
LEAVE; /* exit outer scope */
(void)POPMARK; /* pop src */
(void)POPMARK; /* pop dst */
}
}
else {
ENTER; /* enter inner scope */
}
}
{
dSP;
cxstack_ix++; /* temporarily protect top context */
sv_2mortal(*MARK);
}
else {
}
}
else
}
else {
*MARK = &PL_sv_undef;
}
}
TAINT_NOT; /* Each item is independent */
}
}
}
cxstack_ix--;
return pop_return();
}
/* This duplicates the above code because the above code must not
* get any slower by more conditions */
{
dSP;
cxstack_ix++; /* temporarily protect top context */
/* We are an argument to a function or grep().
* This kind of lvalueness was legal before lvalue
* subroutines too, so be backward compatible:
* cannot report errors. */
/* Scalar context *is* possible, on the LHS of -> only,
* as in f()->meth(). But this is not an lvalue. */
goto temporise;
goto temporise_array;
/* empty */ ;
else {
/* Can be a localized value subject to deletion. */
(void)SvREFCNT_inc(*mark);
}
}
}
}
/* Here we go for robustness, not for speed, so we change all
* the refcounts so the caller gets a live guy. Cannot set
* TEMP, so sv_2mortal is out of question. */
cxstack_ix--;
}
EXTEND_MORTAL(1);
cxstack_ix--;
: "a readonly value" : "a temporary");
}
else { /* Can be a localized value
* subject to deletion. */
(void)SvREFCNT_inc(*mark);
}
}
else { /* Should not happen? */
cxstack_ix--;
}
}
if (*mark != &PL_sv_undef
/* Might be flattened array after $#array = */
cxstack_ix--;
}
else {
/* Can be a localized value subject to deletion. */
(void)SvREFCNT_inc(*mark);
}
}
}
}
else {
sv_2mortal(*MARK);
}
else {
}
}
else
}
else {
*MARK = &PL_sv_undef;
}
}
TAINT_NOT; /* Each item is independent */
}
}
}
}
cxstack_ix--;
return pop_return();
}
{
if (!PERLDB_SUB_NN) {
/* Use GV from the stack as a fallback. */
/* GV is potentially non-unique, or contain different CV. */
}
else {
}
}
else {
}
return cv;
}
{
if (!sv)
default:
char *sym;
if (hasargs)
}
if (SvGMAGICAL(sv)) {
goto got_rv;
}
else
if (!sym)
break;
}
{
}
break;
/* FALL THROUGH */
case SVt_PVHV:
case SVt_PVAV:
case SVt_PVCV:
break;
case SVt_PVGV:
if (!cv) {
goto try_autoload;
}
break;
}
/* anonymous or undef'd function leaves us no recourse */
/* autoloaded stub? */
}
/* should call AUTOLOAD now? */
else {
FALSE)))
{
}
/* sorry */
else {
sub_name = sv_newmortal();
}
}
if (!cv)
goto retry;
}
if (!cv)
}
#ifdef USE_5005THREADS
/*
* First we need to check if the sub or method requires locking.
* If so, we gain a lock on the CV, the first argument or the
* stash (for static methods), as appropriate. This has to be
* inline because for FAKE_THREADS, COND_WAIT inlines code to
* reschedule by returning a new op.
*/
else {
{
}
}
else {
}
}
else {
}
else {
}
}
/*
* Now we have permission to enter the sub, we must distinguish
* four cases. (0) It's an XSUB (in which case we don't care
* about ownership); (1) it's ours already (and we're recursing);
* (2) it's free (but we may already be using a cached clone);
* (3) another thread owns it. Case (1) is easy: we just use it.
* Case (2) means we look for a clone--if we have one, use it
* otherwise grab ownership of cv. Case (3) means we look for a
* clone (for non-XSUBs) and have to create one if we don't
* already have one.
* Why look for a clone in case (2) when we could just grab
* ownership of cv straight away? Well, we could be recursing,
* i.e. we originally tried to enter cv while another thread
* owned it (hence we used a clone) but it has been freed up
* and we're now recursing into it. It may or may not be "better"
* to use the clone but at least CvDEPTH can be trusted.
*/
else {
/* Case (2) or (3) */
/*
* XXX Might it be better to release CvMUTEXP(cv) while we
* do the hv_fetch? We might find someone has pinched it
* when we look again, in which case we would be in case
* (3) instead of (2) so we'd have to clone. Would the fact
* that we released the mutex more quickly make up for this?
*/
{
/* We already have a clone to use */
"entersub: %p already has clone %p:%s\n",
}
else {
/* (2) => grab ownership of cv. (3) => make clone */
"entersub: %p grabbing %p:%s in stash %s\n",
}
else {
/* Make a new clone. */
"entersub: %p cloning %p:%s\n",
/*
* We're creating a new clone so there's no race
* between the original MUTEX_UNLOCK and the
* SvREFCNT_inc since no one will be trying to undef
* it out from underneath us. At least, I don't think
* there's a race...
*/
}
}
}
#endif /* USE_5005THREADS */
#ifdef PERL_XSUB_OLDSTYLE
if (CvOLDSTYLE(cv)) {
/* We dont worry to copy from @_. */
SP--;
}
items);
}
else
#endif /* PERL_XSUB_OLDSTYLE */
{
if (!hasargs) {
/* Need to copy @_ to stack. Alternative may be to
* switch stack to @_, and copy return values
* back. This would allow popping @_ in XSUB, e.g.. XXXX */
#ifdef USE_5005THREADS
#else
#endif /* USE_5005THREADS */
if (items) {
/* Mark is at the end of the stack. */
PUTBACK ;
}
}
/* We assume first XSUB in &DB::sub is the called one. */
if (PL_curcopdb) {
PL_curcopdb = NULL;
}
/* Do we need to open block here? XXXX */
/* Enforce some sanity in scalar context. */
else
}
}
return NORMAL;
}
else {
/* XXX This would be a natural place to set C<PL_compcv = cv> so
* that eval'' ops within this sub know the correct lexical space.
* Owing the speed considerations, we choose instead to search for
* the cv using find_runcv() when calling doeval().
*/
}
#ifdef USE_5005THREADS
if (!hasargs) {
if (items) {
/* Mark is at the end of the stack. */
PUTBACK ;
}
}
#endif /* USE_5005THREADS */
#ifndef USE_5005THREADS
if (hasargs)
#endif /* USE_5005THREADS */
{
#if 0
"%p entersub preparing @_\n", thr));
#endif
/* @_ is normally not REAL--this should only ever
* happen when DB::sub() calls things that modify @_ */
AvREAL_off(av);
AvREIFY_on(av);
}
#ifndef USE_5005THREADS
#endif /* USE_5005THREADS */
++MARK;
}
}
}
while (items--) {
if (*MARK)
SvTEMP_off(*MARK);
MARK++;
}
}
/* warning must come *after* we fully set up the context
* stuff so that __WARN__ handlers can safely dounwind()
* if they want to
*/
#if 0
#endif
}
}
void
{
else {
tmpstr);
}
}
{
dSP;
if (elem > 0)
if (lval) {
if (!defer)
lv = sv_newmortal();
}
}
}
void
{
if (SvGMAGICAL(sv))
if (SvREADONLY(sv))
}
switch (to_what) {
case OPpDEREF_SV:
break;
case OPpDEREF_AV:
break;
case OPpDEREF_HV:
break;
}
SvSETMAGIC(sv);
}
}
{
dSP;
}
}
}
{
dSP;
}
{
char* name;
char* packname = 0;
if (!sv)
if (SvGMAGICAL(sv))
else {
/* this isn't a reference */
if (he) {
goto fetch;
}
}
!(packname) ||
{
/* this isn't the name of a filehandle either */
if (!packname ||
))
{
: "on an undefined value");
}
/* assume it's a package name */
if (!stash)
else {
}
goto fetch;
}
/* it _is_ a filehandle name -- replace with a reference */
}
/* if we got here, ob should be a reference or a glob */
{
name);
}
/* NOTE: stash may be null, hope hv_fetch_ent and
gv_fetchmethod can cope (it seems they can) */
/* shortcut for simple names */
if (hashp) {
if (he) {
}
}
if (!gv) {
/* This code tries to figure out just what went wrong with
gv_fetchmethod. It therefore needs to duplicate a lot of
the internals of that function. We can't move it inside
Perl_gv_fetchmethod_autoload(), however, since that would
cause UNIVERSAL->can("NoSuchPackage::foo") to croak, and we
don't want that.
*/
char* p;
for (p = name; *p; p++) {
if (*p == '\'')
else if (*p == ':' && *(p + 1) == ':')
}
/* the method name is unqualified or starts with SUPER:: */
}
else {
/* the method name is qualified */
}
/* we're relying on gv_fetchmethod not autovivifying the stash */
"Can't locate object method \"%s\" via package \"%.*s\"",
}
else {
"Can't locate object method \"%s\" via package \"%.*s\""
" (perhaps you forgot to load \"%.*s\"?)",
}
}
}
#ifdef USE_5005THREADS
static void
{
}
#endif /* USE_5005THREADS */