summaryrefslogtreecommitdiff
path: root/pp_hot.c
diff options
context:
space:
mode:
Diffstat (limited to 'pp_hot.c')
-rw-r--r--pp_hot.c114
1 files changed, 57 insertions, 57 deletions
diff --git a/pp_hot.c b/pp_hot.c
index 36a33ff04d..b652a63b49 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -35,7 +35,7 @@
#ifdef USE_THREADS
STATIC void
-unset_cvowner(pTHX_ void *cvarg)
+S_unset_cvowner(pTHX_ void *cvarg)
{
register CV* cv = (CV *) cvarg;
#ifdef DEBUGGING
@@ -212,7 +212,7 @@ PP(pp_readline)
dSP;
XPUSHs((SV*)PL_last_in_gv);
PUTBACK;
- pp_rv2gv(ARGS);
+ pp_rv2gv();
PL_last_in_gv = (GV*)(*PL_stack_sp--);
}
}
@@ -233,7 +233,7 @@ PP(pp_preinc)
{
djSP;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
- croak(PL_no_modify);
+ Perl_croak(aTHX_ PL_no_modify);
if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MAX)
{
@@ -351,7 +351,7 @@ PP(pp_print)
if (ckWARN(WARN_UNOPENED)) {
SV* sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
- warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a));
+ Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a));
}
SETERRNO(EBADF,RMS$_IFI);
@@ -362,10 +362,10 @@ PP(pp_print)
SV* sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
if (IoIFP(io))
- warner(WARN_IO, "Filehandle %s opened only for input",
+ Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for input",
SvPV(sv,n_a));
else if (ckWARN(WARN_CLOSED))
- warner(WARN_CLOSED, "print on closed filehandle %s",
+ Perl_warner(aTHX_ WARN_CLOSED, "print on closed filehandle %s",
SvPV(sv,n_a));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
@@ -426,7 +426,7 @@ PP(pp_rv2av)
av = (AV*)SvRV(sv);
if (SvTYPE(av) != SVt_PVAV)
- DIE("Not an ARRAY reference");
+ DIE(aTHX_ "Not an ARRAY reference");
if (PL_op->op_flags & OPf_REF) {
SETs((SV*)av);
RETURN;
@@ -455,9 +455,9 @@ PP(pp_rv2av)
if (!SvOK(sv)) {
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
- DIE(PL_no_usym, "an ARRAY");
+ DIE(aTHX_ PL_no_usym, "an ARRAY");
if (ckWARN(WARN_UNINITIALIZED))
- warner(WARN_UNINITIALIZED, PL_warn_uninit);
+ Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
if (GIMME == G_ARRAY) {
(void)POPs;
RETURN;
@@ -474,7 +474,7 @@ PP(pp_rv2av)
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(PL_no_symref, sym, "an ARRAY");
+ DIE(aTHX_ PL_no_symref, sym, "an ARRAY");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
}
}
@@ -526,7 +526,7 @@ PP(pp_rv2hv)
hv = (HV*)SvRV(sv);
if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV)
- DIE("Not a HASH reference");
+ DIE(aTHX_ "Not a HASH reference");
if (PL_op->op_flags & OPf_REF) {
SETs((SV*)hv);
RETURN;
@@ -555,9 +555,9 @@ PP(pp_rv2hv)
if (!SvOK(sv)) {
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
- DIE(PL_no_usym, "a HASH");
+ DIE(aTHX_ PL_no_usym, "a HASH");
if (ckWARN(WARN_UNINITIALIZED))
- warner(WARN_UNINITIALIZED, PL_warn_uninit);
+ Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
if (GIMME == G_ARRAY) {
SP--;
RETURN;
@@ -574,7 +574,7 @@ PP(pp_rv2hv)
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(PL_no_symref, sym, "a HASH");
+ DIE(aTHX_ PL_no_symref, sym, "a HASH");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
}
}
@@ -593,14 +593,14 @@ PP(pp_rv2hv)
if (GIMME == G_ARRAY) { /* array wanted */
*PL_stack_sp = (SV*)hv;
- return do_kv(ARGS);
+ return do_kv();
}
else {
dTARGET;
if (SvTYPE(hv) == SVt_PVAV)
hv = avhv_keys((AV*)hv);
if (HvFILL(hv))
- sv_setpvf(TARG, "%ld/%ld",
+ Perl_sv_setpvf(aTHX_ TARG, "%ld/%ld",
(long)HvFILL(hv), (long)HvMAX(hv) + 1);
else
sv_setiv(TARG, 0);
@@ -711,9 +711,9 @@ PP(pp_aassign)
SvROK(*relem) &&
( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
- warner(WARN_UNSAFE, "Reference found where even-sized list expected");
+ Perl_warner(aTHX_ WARN_UNSAFE, "Reference found where even-sized list expected");
else
- warner(WARN_UNSAFE, "Odd number of elements in hash assignment");
+ Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment");
}
tmpstr = NEWSV(29,0);
didstore = hv_store_ent(hash,*relem,tmpstr,0);
@@ -767,7 +767,7 @@ PP(pp_aassign)
# endif /* HAS_SETEUID */
if (PL_delaymagic & DM_UID) {
if (PL_uid != PL_euid)
- DIE("No setreuid available");
+ DIE(aTHX_ "No setreuid available");
(void)PerlProc_setuid(PL_uid);
}
# endif /* HAS_SETREUID */
@@ -796,7 +796,7 @@ PP(pp_aassign)
# endif /* HAS_SETEGID */
if (PL_delaymagic & DM_GID) {
if (PL_gid != PL_egid)
- DIE("No setregid available");
+ DIE(aTHX_ "No setregid available");
(void)PerlProc_setgid(PL_gid);
}
# endif /* HAS_SETREGID */
@@ -869,7 +869,7 @@ PP(pp_match)
s = SvPV(TARG, len);
strend = s + len;
if (!s)
- DIE("panic: do_match");
+ DIE(aTHX_ "panic: do_match");
rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
(PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
TAINT_NOT;
@@ -998,7 +998,7 @@ play_it_again:
rx->float_substr = Nullsv;
}
}
- if (CALLREGEXEC(rx, s, strend, truebase, minmatch, TARG, NULL, r_flags))
+ if (CALLREGEXEC(aTHX_ rx, s, strend, truebase, minmatch, TARG, NULL, r_flags))
{
PL_curpm = pm;
if (pm->op_pmflags & PMf_ONCE)
@@ -1305,10 +1305,10 @@ Perl_do_readline(pTHX)
if (!fp) {
if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
if (type == OP_GLOB)
- warner(WARN_CLOSED, "glob failed (can't start child: %s)",
+ Perl_warner(aTHX_ WARN_CLOSED, "glob failed (can't start child: %s)",
Strerror(errno));
else
- warner(WARN_CLOSED, "Read on closed filehandle <%s>",
+ Perl_warner(aTHX_ WARN_CLOSED, "Read on closed filehandle <%s>",
GvENAME(PL_last_in_gv));
}
if (gimme == G_SCALAR) {
@@ -1357,7 +1357,7 @@ Perl_do_readline(pTHX)
}
else if (type == OP_GLOB) {
if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {
- warner(WARN_CLOSED,
+ Perl_warner(aTHX_ WARN_CLOSED,
"glob failed (child exited with status %d%s)",
STATUS_CURRENT >> 8,
(STATUS_CURRENT & 0x80) ? ", core dumped" : "");
@@ -1454,7 +1454,7 @@ PP(pp_helem)
}
else if (SvTYPE(hv) == SVt_PVAV) {
if (PL_op->op_private & OPpLVAL_INTRO)
- DIE("Can't localize pseudo-hash element");
+ DIE(aTHX_ "Can't localize pseudo-hash element");
svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, 0);
}
else {
@@ -1466,7 +1466,7 @@ PP(pp_helem)
SV* key2;
if (!defer) {
STRLEN n_a;
- DIE(PL_no_helem, SvPV(keysv, n_a));
+ DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
}
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
@@ -1566,7 +1566,7 @@ PP(pp_iter)
EXTEND(SP, 1);
cx = &cxstack[cxstack_ix];
if (CxTYPE(cx) != CXt_LOOP)
- DIE("panic: pp_iter");
+ DIE(aTHX_ "panic: pp_iter");
av = cx->blk_loop.iterary;
if (SvTYPE(av) != SVt_PVAV) {
@@ -1696,7 +1696,7 @@ PP(pp_subst)
if (SvREADONLY(TARG)
|| (SvTYPE(TARG) > SVt_PVLV
&& !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
- croak(PL_no_modify);
+ Perl_croak(aTHX_ PL_no_modify);
PUTBACK;
s = SvPV(TARG, len);
@@ -1710,7 +1710,7 @@ PP(pp_subst)
force_it:
if (!pm || !s)
- DIE("panic: do_subst");
+ DIE(aTHX_ "panic: do_subst");
strend = s + len;
maxiters = 2*(strend - s) + 10; /* We can match twice at each
@@ -1784,7 +1784,7 @@ PP(pp_subst)
/* can do inplace substitution? */
if (c && clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
&& !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) {
- if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL, r_flags)) {
+ if (!CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL, r_flags)) {
SPAGAIN;
PUSHs(&PL_sv_no);
LEAVE_SCOPE(oldsave);
@@ -1842,7 +1842,7 @@ PP(pp_subst)
else {
do {
if (iters++ > maxiters)
- DIE("Substitution loop");
+ DIE(aTHX_ "Substitution loop");
rxtainted |= RX_MATCH_TAINTED(rx);
m = rx->startp[0] + orig;
/*SUPPRESS 560*/
@@ -1856,7 +1856,7 @@ PP(pp_subst)
d += clen;
}
s = rx->endp[0] + orig;
- } while (CALLREGEXEC(rx, s, strend, orig, s == m,
+ } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m,
Nullsv, NULL, REXEC_NOT_FIRST)); /* don't match same null twice */
if (s != d) {
i = strend - s;
@@ -1879,7 +1879,7 @@ PP(pp_subst)
RETURN;
}
- if (CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL, r_flags)) {
+ if (CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL, r_flags)) {
if (force_on_match) {
force_on_match = 0;
s = SvPV_force(TARG, len);
@@ -1898,7 +1898,7 @@ PP(pp_subst)
r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
do {
if (iters++ > maxiters)
- DIE("Substitution loop");
+ DIE(aTHX_ "Substitution loop");
rxtainted |= RX_MATCH_TAINTED(rx);
if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
m = s;
@@ -1914,7 +1914,7 @@ PP(pp_subst)
sv_catpvn(dstr, c, clen);
if (once)
break;
- } while (CALLREGEXEC(rx, s, strend, orig, s == m, TARG, NULL, r_flags));
+ } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m, TARG, NULL, r_flags));
sv_catpvn(dstr, s, strend - s);
(void)SvOOK_off(TARG);
@@ -2041,7 +2041,7 @@ PP(pp_leavesub)
}
STATIC CV *
-get_db_sub(pTHX_ SV **svp, CV *cv)
+S_get_db_sub(pTHX_ SV **svp, CV *cv)
{
dTHR;
SV *dbsv = GvSV(PL_DBsub);
@@ -2087,7 +2087,7 @@ PP(pp_entersub)
bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
if (!sv)
- DIE("Not a CODE reference");
+ DIE(aTHX_ "Not a CODE reference");
switch (SvTYPE(sv)) {
default:
if (!SvROK(sv)) {
@@ -2106,9 +2106,9 @@ PP(pp_entersub)
else
sym = SvPV(sv, n_a);
if (!sym)
- DIE(PL_no_usym, "a subroutine");
+ DIE(aTHX_ PL_no_usym, "a subroutine");
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(PL_no_symref, sym, "a subroutine");
+ DIE(aTHX_ PL_no_symref, sym, "a subroutine");
cv = get_cv(sym, TRUE);
break;
}
@@ -2122,7 +2122,7 @@ PP(pp_entersub)
/* FALL THROUGH */
case SVt_PVHV:
case SVt_PVAV:
- DIE("Not a CODE reference");
+ DIE(aTHX_ "Not a CODE reference");
case SVt_PVCV:
cv = (CV*)sv;
break;
@@ -2147,7 +2147,7 @@ PP(pp_entersub)
/* anonymous or undef'd function leaves us no recourse */
if (CvANON(cv) || !(gv = CvGV(cv)))
- DIE("Undefined subroutine called");
+ DIE(aTHX_ "Undefined subroutine called");
/* autoloaded stub? */
if (cv != GvCV(gv)) {
@@ -2165,11 +2165,11 @@ try_autoload:
else {
sub_name = sv_newmortal();
gv_efullname3(sub_name, gv, Nullch);
- DIE("Undefined subroutine &%s called", SvPVX(sub_name));
+ DIE(aTHX_ "Undefined subroutine &%s called", SvPVX(sub_name));
}
}
if (!cv)
- DIE("Not a CODE reference");
+ DIE(aTHX_ "Not a CODE reference");
goto retry;
}
@@ -2177,7 +2177,7 @@ try_autoload:
if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
cv = get_db_sub(&sv, cv);
if (!cv)
- DIE("No DBsub routine");
+ DIE(aTHX_ "No DBsub routine");
}
#ifdef USE_THREADS
@@ -2200,7 +2200,7 @@ try_autoload:
|| !(sv = AvARRAY(av)[0]))
{
MUTEX_UNLOCK(CvMUTEXP(cv));
- croak("no argument for locked method call");
+ Perl_croak(aTHX_ "no argument for locked method call");
}
}
if (SvROK(sv))
@@ -2226,7 +2226,7 @@ try_autoload:
DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n",
thr, sv);)
MUTEX_UNLOCK(MgMUTEXP(mg));
- save_destructor(unlock_condpair, sv);
+ save_destructor(Perl_unlock_condpair, sv);
}
MUTEX_LOCK(CvMUTEXP(cv));
}
@@ -2271,7 +2271,7 @@ try_autoload:
CvOWNER(cv) = thr;
SvREFCNT_inc(cv);
if (CvDEPTH(cv) == 0)
- SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
+ SAVEDESTRUCTOR(S_unset_cvowner, (void*) cv);
}
else {
/* (2) => grab ownership of cv. (3) => make clone */
@@ -2308,7 +2308,7 @@ try_autoload:
DEBUG_S(if (CvDEPTH(cv) != 0)
PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n",
CvDEPTH(cv)););
- SAVEDESTRUCTOR(unset_cvowner, (void*) cv);
+ SAVEDESTRUCTOR(S_unset_cvowner, (void*) cv);
}
}
#endif /* USE_THREADS */
@@ -2366,7 +2366,7 @@ try_autoload:
PL_curcopdb = NULL;
}
/* Do we need to open block here? XXXX */
- (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
+ (void)(*CvXSUB(cv))(aTHX_ cv);
/* Enforce some sanity in scalar context. */
if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) {
@@ -2515,11 +2515,11 @@ void
Perl_sub_crush_depth(pTHX_ CV *cv)
{
if (CvANON(cv))
- warner(WARN_RECURSION, "Deep recursion on anonymous subroutine");
+ Perl_warner(aTHX_ WARN_RECURSION, "Deep recursion on anonymous subroutine");
else {
SV* tmpstr = sv_newmortal();
gv_efullname3(tmpstr, CvGV(cv), Nullch);
- warner(WARN_RECURSION, "Deep recursion on subroutine \"%s\"",
+ Perl_warner(aTHX_ WARN_RECURSION, "Deep recursion on subroutine \"%s\"",
SvPVX(tmpstr));
}
}
@@ -2543,7 +2543,7 @@ PP(pp_aelem)
if (!svp || *svp == &PL_sv_undef) {
SV* lv;
if (!defer)
- DIE(PL_no_aelem, elem);
+ DIE(aTHX_ PL_no_aelem, elem);
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
@@ -2573,7 +2573,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
mg_get(sv);
if (!SvOK(sv)) {
if (SvREADONLY(sv))
- croak(PL_no_modify);
+ Perl_croak(aTHX_ PL_no_modify);
if (SvTYPE(sv) < SVt_RV)
sv_upgrade(sv, SVt_RV);
else if (SvTYPE(sv) >= SVt_PV) {
@@ -2638,7 +2638,7 @@ PP(pp_method)
: !isIDFIRST(*packname)
))
{
- DIE("Can't call method \"%s\" %s", name,
+ DIE(aTHX_ "Can't call method \"%s\" %s", name,
SvOK(sv)? "without a package or object reference"
: "on an undefined value");
}
@@ -2649,7 +2649,7 @@ PP(pp_method)
}
if (!ob || !SvOBJECT(ob))
- DIE("Can't call method \"%s\" on unblessed reference", name);
+ DIE(aTHX_ "Can't call method \"%s\" on unblessed reference", name);
stash = SvSTASH(ob);
@@ -2674,7 +2674,7 @@ PP(pp_method)
packname = name;
packlen = sep - name;
}
- DIE("Can't locate object method \"%s\" via package \"%.*s\"",
+ DIE(aTHX_ "Can't locate object method \"%s\" via package \"%.*s\"",
leaf, (int)packlen, packname);
}
SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
View Lorry Controller Status