/* pp.c
*
- * Copyright (c) 1991-1999, Larry Wall
+ * Copyright (c) 1991-2000, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*/
#include "EXTERN.h"
+#define PERL_IN_PP_C
#include "perl.h"
/*
* have an integral type (except char) small enough to be represented
* in a double without loss; that is, it has no 32-bit type.
*/
-#if LONGSIZE > 4 && defined(_CRAY) && !defined(_CRAYMPP)
+#if LONGSIZE > 4 && defined(_CRAY)
# define BW_BITS 32
# define BW_MASK ((1 << BW_BITS) - 1)
# define BW_SIGN (1 << (BW_BITS - 1))
# define PERL_NATINT_PACK
#endif
-#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
+#if LONGSIZE > 4 && defined(_CRAY)
# if BYTEORDER == 0x12345678
# define OFF16(p) (char*)(p)
# define OFF32(p) (char*)(p)
# define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32)
#endif
-#ifndef PERL_OBJECT
-static void doencodes _((SV* sv, char* s, I32 len));
-static SV* refto _((SV* sv));
-static U32 seed _((void));
-#endif
-
/* variations on pp_null */
#ifdef I_UNISTD
RETURN;
gimme = GIMME_V;
if (gimme == G_ARRAY) {
- RETURNOP(do_kv(ARGS));
+ RETURNOP(do_kv());
}
else if (gimme == G_SCALAR) {
SV* sv = sv_newmortal();
if (HvFILL((HV*)TARG))
- sv_setpvf(sv, "%ld/%ld",
+ Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
(long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1);
else
sv_setiv(sv, 0);
PP(pp_padany)
{
- DIE("NOT IMPL LINE %d",__LINE__);
+ DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
}
/* Translations. */
PP(pp_rv2gv)
{
- djSP; dTOPss;
+ djSP; dTOPss;
if (SvROK(sv)) {
wasref:
sv = (SV*) gv;
}
else if (SvTYPE(sv) != SVt_PVGV)
- DIE("Not a GLOB reference");
+ DIE(aTHX_ "Not a GLOB reference");
}
else {
if (SvTYPE(sv) != SVt_PVGV) {
goto wasref;
}
if (!SvOK(sv)) {
+ /* If this is a 'my' scalar and flag is set then vivify
+ * NI-S 1999/05/07
+ */
+ if (PL_op->op_private & OPpDEREF) {
+ char *name;
+ GV *gv;
+ if (cUNOP->op_targ) {
+ STRLEN len;
+ SV *namesv = PL_curpad[cUNOP->op_targ];
+ name = SvPV(namesv, len);
+ gv = (GV*)NEWSV(0,0);
+ gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
+ }
+ else {
+ name = CopSTASHPV(PL_curcop);
+ gv = newGVgen(name);
+ }
+ sv_upgrade(sv, SVt_RV);
+ SvRV(sv) = (SV*)gv;
+ SvROK_on(sv);
+ SvSETMAGIC(sv);
+ goto wasref;
+ }
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
- DIE(PL_no_usym, "a symbol");
+ DIE(aTHX_ PL_no_usym, "a symbol");
if (ckWARN(WARN_UNINITIALIZED))
- warner(WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
RETSETUNDEF;
}
sym = SvPV(sv, n_a);
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(PL_no_symref, sym, "a symbol");
+ DIE(aTHX_ PL_no_symref, sym, "a symbol");
sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
}
}
case SVt_PVAV:
case SVt_PVHV:
case SVt_PVCV:
- DIE("Not a SCALAR reference");
+ DIE(aTHX_ "Not a SCALAR reference");
}
}
else {
if (!SvOK(sv)) {
if (PL_op->op_flags & OPf_REF ||
PL_op->op_private & HINT_STRICT_REFS)
- DIE(PL_no_usym, "a SCALAR");
+ DIE(aTHX_ PL_no_usym, "a SCALAR");
if (ckWARN(WARN_UNINITIALIZED))
- warner(WARN_UNINITIALIZED, PL_warn_uninit);
+ report_uninit();
RETSETUNDEF;
}
sym = SvPV(sv, n_a);
}
else {
if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(PL_no_symref, sym, "a SCALAR");
+ DIE(aTHX_ PL_no_symref, sym, "a SCALAR");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
}
}
mg = mg_find(sv, 'g');
if (mg && mg->mg_len >= 0) {
I32 i = mg->mg_len;
- if (IN_UTF8)
+ if (DO_UTF8(sv))
sv_pos_b2u(sv, &i);
PUSHi(i + PL_curcop->cop_arybase);
RETURN;
if (cv) {
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+ if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv))
+ DIE(aTHX_ "Can't modify non-lvalue subroutine call");
}
else
cv = (CV*)&PL_sv_undef;
goto set;
else { /* None such */
nonesuch:
- croak("Cannot find an opnumber for \"%s\"", s+6);
+ DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
}
}
}
}
STATIC SV*
-refto(SV *sv)
+S_refto(pTHX_ SV *sv)
{
SV* rv;
vivify_defelem(sv);
if (!(sv = LvTARG(sv)))
sv = &PL_sv_undef;
+ else
+ (void)SvREFCNT_inc(sv);
+ }
+ else if (SvTYPE(sv) == SVt_PVAV) {
+ if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv))
+ av_reify((AV*)sv);
+ SvTEMP_off(sv);
+ (void)SvREFCNT_inc(sv);
}
else if (SvPADTMP(sv))
sv = newSVsv(sv);
HV *stash;
if (MAXARG == 1)
- stash = PL_curcop->cop_stash;
+ stash = CopSTASH(PL_curcop);
else {
SV *ssv = POPs;
STRLEN len;
char *ptr = SvPV(ssv,len);
if (ckWARN(WARN_UNSAFE) && len == 0)
- warner(WARN_UNSAFE,
+ Perl_warner(aTHX_ WARN_UNSAFE,
"Explicit blessing to '' (assuming package main)");
stash = gv_stashpvn(ptr, len, TRUE);
}
PP(pp_study)
{
djSP; dPOPss;
- register UNOP *unop = cUNOP;
register unsigned char *s;
register I32 pos;
register I32 ch;
snext = PL_screamnext;
if (!sfirst || !snext)
- DIE("do_study: out of memory");
+ DIE(aTHX_ "do_study: out of memory");
for (ch = 256; ch; --ch)
*sfirst++ = -1;
break;
case SVt_PVCV:
if (ckWARN(WARN_UNSAFE) && cv_const_sv((CV*)sv))
- warner(WARN_UNSAFE, "Constant subroutine %s undefined",
+ Perl_warner(aTHX_ WARN_UNSAFE, "Constant subroutine %s undefined",
CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
/* FALL THROUGH */
case SVt_PVFM:
Newz(602, gp, 1, GP);
GvGP(sv) = gp_ref(gp);
GvSV(sv) = NEWSV(72,0);
- GvLINE(sv) = PL_curcop->cop_line;
+ GvLINE(sv) = CopLINE(PL_curcop);
GvEGV(sv) = (GV*)sv;
GvMULTI_on(sv);
}
{
djSP;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
- croak(PL_no_modify);
- if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+ DIE(aTHX_ PL_no_modify);
+ if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MIN)
{
--SvIVX(TOPs);
{
djSP; dTARGET;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
- croak(PL_no_modify);
+ DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
- if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+ if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MAX)
{
++SvIVX(TOPs);
PP(pp_postdec)
{
djSP; dTARGET;
- if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
- croak(PL_no_modify);
+ if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+ DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
- if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+ if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
SvIVX(TOPs) != IV_MIN)
{
--SvIVX(TOPs);
djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPPOPnnrl;
- double value;
+ NV value;
if (right == 0.0)
- DIE("Illegal division by zero");
+ DIE(aTHX_ "Illegal division by zero");
#ifdef SLOPPYDIVIDE
/* insure that 20./5. == 4. */
{
IV k;
- if ((double)I_V(left) == left &&
- (double)I_V(right) == right &&
+ if ((NV)I_V(left) == left &&
+ (NV)I_V(right) == right &&
(k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
value = k;
}
{
djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
- UV left;
- UV right;
- bool left_neg;
- bool right_neg;
- UV ans;
-
- if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
- IV i = SvIVX(POPs);
- right = (right_neg = (i < 0)) ? -i : i;
- }
- else {
- double n = POPn;
- right = U_V((right_neg = (n < 0)) ? -n : n);
- }
+ UV left;
+ UV right;
+ bool left_neg;
+ bool right_neg;
+ bool use_double = 0;
+ NV dright;
+ NV dleft;
+
+ if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
+ IV i = SvIVX(POPs);
+ right = (right_neg = (i < 0)) ? -i : i;
+ }
+ else {
+ dright = POPn;
+ use_double = 1;
+ right_neg = dright < 0;
+ if (right_neg)
+ dright = -dright;
+ }
- if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
- IV i = SvIVX(POPs);
- left = (left_neg = (i < 0)) ? -i : i;
- }
- else {
- double n = POPn;
- left = U_V((left_neg = (n < 0)) ? -n : n);
- }
+ if (!use_double && SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
+ IV i = SvIVX(POPs);
+ left = (left_neg = (i < 0)) ? -i : i;
+ }
+ else {
+ dleft = POPn;
+ if (!use_double) {
+ use_double = 1;
+ dright = right;
+ }
+ left_neg = dleft < 0;
+ if (left_neg)
+ dleft = -dleft;
+ }
- if (!right)
- DIE("Illegal modulus zero");
-
- ans = left % right;
- if ((left_neg != right_neg) && ans)
- ans = right - ans;
- if (right_neg) {
- /* XXX may warn: unary minus operator applied to unsigned type */
- /* could change -foo to be (~foo)+1 instead */
- if (ans <= ~((UV)IV_MAX)+1)
- sv_setiv(TARG, ~ans+1);
- else
- sv_setnv(TARG, -(double)ans);
- }
- else
- sv_setuv(TARG, ans);
- PUSHTARG;
- RETURN;
+ if (use_double) {
+ NV dans;
+
+#if 1
+/* Somehow U_V is pessimized even if CASTFLAGS is 0 */
+# if CASTFLAGS & 2
+# define CAST_D2UV(d) U_V(d)
+# else
+# define CAST_D2UV(d) ((UV)(d))
+# endif
+ /* Tried to do this only in the case DOUBLESIZE <= UV_SIZE,
+ * or, in other words, precision of UV more than of NV.
+ * But in fact the approach below turned out to be an
+ * optimization - floor() may be slow */
+ if (dright <= UV_MAX && dleft <= UV_MAX) {
+ right = CAST_D2UV(dright);
+ left = CAST_D2UV(dleft);
+ goto do_uv;
+ }
+#endif
+
+ /* Backward-compatibility clause: */
+ dright = floor(dright + 0.5);
+ dleft = floor(dleft + 0.5);
+
+ if (!dright)
+ DIE(aTHX_ "Illegal modulus zero");
+
+ dans = Perl_fmod(dleft, dright);
+ if ((left_neg != right_neg) && dans)
+ dans = dright - dans;
+ if (right_neg)
+ dans = -dans;
+ sv_setnv(TARG, dans);
+ }
+ else {
+ UV ans;
+
+ do_uv:
+ if (!right)
+ DIE(aTHX_ "Illegal modulus zero");
+
+ ans = left % right;
+ if ((left_neg != right_neg) && ans)
+ ans = right - ans;
+ if (right_neg) {
+ /* XXX may warn: unary minus operator applied to unsigned type */
+ /* could change -foo to be (~foo)+1 instead */
+ if (ans <= ~((UV)IV_MAX)+1)
+ sv_setiv(TARG, ~ans+1);
+ else
+ sv_setnv(TARG, -(NV)ans);
+ }
+ else
+ sv_setuv(TARG, ans);
+ }
+ PUSHTARG;
+ RETURN;
}
}
sv_setsv(TARG, sv);
*SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
}
- else if (IN_UTF8 && *(U8*)s >= 0xc0 && isIDFIRST_utf8((U8*)s)) {
+ else if (DO_UTF8(sv) && *(U8*)s >= 0xc0 && isIDFIRST_utf8((U8*)s)) {
sv_setpvn(TARG, "-", 1);
sv_catsv(TARG, sv);
}
{
dPOPiv;
if (value == 0)
- DIE("Illegal division by zero");
+ DIE(aTHX_ "Illegal division by zero");
value = POPi / value;
PUSHi( value );
RETURN;
{
dPOPTOPiirl;
if (!right)
- DIE("Illegal modulus zero");
+ DIE(aTHX_ "Illegal modulus zero");
SETi( left % right );
RETURN;
}
djSP; dTARGET; tryAMAGICbin(atan2,0);
{
dPOPTOPnnrl;
- SETn(atan2(left, right));
+ SETn(Perl_atan2(left, right));
RETURN;
}
}
{
djSP; dTARGET; tryAMAGICun(sin);
{
- double value;
+ NV value;
value = POPn;
- value = sin(value);
+ value = Perl_sin(value);
XPUSHn(value);
RETURN;
}
{
djSP; dTARGET; tryAMAGICun(cos);
{
- double value;
+ NV value;
value = POPn;
- value = cos(value);
+ value = Perl_cos(value);
XPUSHn(value);
RETURN;
}
*/
#ifndef HAS_DRAND48_PROTO
-extern double drand48 _((void));
+extern double drand48 (void);
#endif
PP(pp_rand)
{
djSP; dTARGET;
- double value;
+ NV value;
if (MAXARG < 1)
value = 1.0;
else
}
STATIC U32
-seed(void)
+S_seed(pTHX)
{
/*
* This is really just a quick hack which grabs various garbage
u = (U32)SEED_C1 * when;
# endif
#endif
- u += SEED_C3 * (U32)getpid();
- u += SEED_C4 * (U32)(UV)PL_stack_sp;
+ u += SEED_C3 * (U32)PerlProc_getpid();
+ u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */
- u += SEED_C5 * (U32)(UV)&when;
+ u += SEED_C5 * (U32)PTR2UV(&when);
#endif
return u;
}
{
djSP; dTARGET; tryAMAGICun(exp);
{
- double value;
+ NV value;
value = POPn;
- value = exp(value);
+ value = Perl_exp(value);
XPUSHn(value);
RETURN;
}
{
djSP; dTARGET; tryAMAGICun(log);
{
- double value;
+ NV value;
value = POPn;
if (value <= 0.0) {
- SET_NUMERIC_STANDARD();
- DIE("Can't take log of %g", value);
+ RESTORE_NUMERIC_STANDARD();
+ DIE(aTHX_ "Can't take log of %g", value);
}
- value = log(value);
+ value = Perl_log(value);
XPUSHn(value);
RETURN;
}
{
djSP; dTARGET; tryAMAGICun(sqrt);
{
- double value;
+ NV value;
value = POPn;
if (value < 0.0) {
- SET_NUMERIC_STANDARD();
- DIE("Can't take sqrt of %g", value);
+ RESTORE_NUMERIC_STANDARD();
+ DIE(aTHX_ "Can't take sqrt of %g", value);
}
- value = sqrt(value);
+ value = Perl_sqrt(value);
XPUSHn(value);
RETURN;
}
{
djSP; dTARGET;
{
- double value = TOPn;
+ NV value = TOPn;
IV iv;
if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) {
}
else {
if (value >= 0.0)
- (void)modf(value, &value);
+ (void)Perl_modf(value, &value);
else {
- (void)modf(-value, &value);
+ (void)Perl_modf(-value, &value);
value = -value;
}
iv = I_V(value);
{
djSP; dTARGET; tryAMAGICun(abs);
{
- double value = TOPn;
+ NV value = TOPn;
IV iv;
if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) &&
STRLEN n_a;
tmps = POPpx;
- XPUSHu(scan_hex(tmps, 99, &argtype));
+ XPUSHn(scan_hex(tmps, 99, &argtype));
RETURN;
}
PP(pp_oct)
{
djSP; dTARGET;
- UV value;
+ NV value;
I32 argtype;
char *tmps;
STRLEN n_a;
value = scan_bin(++tmps, 99, &argtype);
else
value = scan_oct(tmps, 99, &argtype);
- XPUSHu(value);
+ XPUSHn(value);
RETURN;
}
PP(pp_length)
{
djSP; dTARGET;
+ SV *sv = TOPs;
- if (IN_UTF8) {
- SETi( sv_len_utf8(TOPs) );
- RETURN;
- }
-
- SETi( sv_len(TOPs) );
+ if (DO_UTF8(sv))
+ SETi(sv_len_utf8(sv));
+ else
+ SETi(sv_len(sv));
RETURN;
}
STRLEN repl_len;
SvTAINTED_off(TARG); /* decontaminate */
+ SvUTF8_off(TARG); /* decontaminate */
if (MAXARG > 2) {
if (MAXARG > 3) {
sv = POPs;
sv = POPs;
PUTBACK;
tmps = SvPV(sv, curlen);
- if (IN_UTF8) {
+ if (DO_UTF8(sv)) {
utfcurlen = sv_len_utf8(sv);
if (utfcurlen == curlen)
utfcurlen = 0;
}
if (fail < 0) {
if (ckWARN(WARN_SUBSTR) || lvalue || repl)
- warner(WARN_SUBSTR, "substr outside of string");
+ Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
RETPUSHUNDEF;
}
else {
- if (utfcurlen)
+ if (utfcurlen) {
sv_pos_u2b(sv, &pos, &rem);
+ SvUTF8_on(TARG);
+ }
tmps += pos;
sv_setpvn(TARG, tmps, rem);
- if (lvalue) { /* it's an lvalue! */
+ if (repl)
+ sv_insert(sv, pos, rem, repl, repl_len);
+ else if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
STRLEN n_a;
SvPV_force(sv,n_a);
if (ckWARN(WARN_SUBSTR))
- warner(WARN_SUBSTR,
+ Perl_warner(aTHX_ WARN_SUBSTR,
"Attempt to use reference as lvalue in substr");
}
if (SvOK(sv)) /* is it defined ? */
LvTARGOFF(TARG) = pos;
LvTARGLEN(TARG) = rem;
}
- else if (repl)
- sv_insert(sv, pos, rem, repl, repl_len);
}
SPAGAIN;
PUSHs(TARG); /* avoid SvSETMAGIC here */
register I32 offset = POPi;
register SV *src = POPs;
I32 lvalue = PL_op->op_flags & OPf_MOD;
- STRLEN srclen;
- unsigned char *s = (unsigned char*)SvPV(src, srclen);
- unsigned long retnum;
- I32 len;
- SvTAINTED_off(TARG); /* decontaminate */
- offset *= size; /* turn into bit offset */
- len = (offset + size + 7) / 8;
- if (offset < 0 || size < 1)
- retnum = 0;
- else {
- if (lvalue) { /* it's an lvalue! */
- if (SvTYPE(TARG) < SVt_PVLV) {
- sv_upgrade(TARG, SVt_PVLV);
- sv_magic(TARG, Nullsv, 'v', Nullch, 0);
- }
-
- LvTYPE(TARG) = 'v';
- if (LvTARG(TARG) != src) {
- if (LvTARG(TARG))
- SvREFCNT_dec(LvTARG(TARG));
- LvTARG(TARG) = SvREFCNT_inc(src);
- }
- LvTARGOFF(TARG) = offset;
- LvTARGLEN(TARG) = size;
- }
- if (len > srclen) {
- if (size <= 8)
- retnum = 0;
- else {
- offset >>= 3;
- if (size == 16) {
- if (offset >= srclen)
- retnum = 0;
- else
- retnum = (unsigned long) s[offset] << 8;
- }
- else if (size == 32) {
- if (offset >= srclen)
- retnum = 0;
- else if (offset + 1 >= srclen)
- retnum = (unsigned long) s[offset] << 24;
- else if (offset + 2 >= srclen)
- retnum = ((unsigned long) s[offset] << 24) +
- ((unsigned long) s[offset + 1] << 16);
- else
- retnum = ((unsigned long) s[offset] << 24) +
- ((unsigned long) s[offset + 1] << 16) +
- (s[offset + 2] << 8);
- }
- }
+ SvTAINTED_off(TARG); /* decontaminate */
+ if (lvalue) { /* it's an lvalue! */
+ if (SvTYPE(TARG) < SVt_PVLV) {
+ sv_upgrade(TARG, SVt_PVLV);
+ sv_magic(TARG, Nullsv, 'v', Nullch, 0);
}
- else if (size < 8)
- retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
- else {
- offset >>= 3;
- if (size == 8)
- retnum = s[offset];
- else if (size == 16)
- retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
- else if (size == 32)
- retnum = ((unsigned long) s[offset] << 24) +
- ((unsigned long) s[offset + 1] << 16) +
- (s[offset + 2] << 8) + s[offset+3];
+ LvTYPE(TARG) = 'v';
+ if (LvTARG(TARG) != src) {
+ if (LvTARG(TARG))
+ SvREFCNT_dec(LvTARG(TARG));
+ LvTARG(TARG) = SvREFCNT_inc(src);
}
+ LvTARGOFF(TARG) = offset;
+ LvTARGLEN(TARG) = size;
}
- sv_setuv(TARG, (UV)retnum);
+ sv_setuv(TARG, do_vecget(src, offset, size));
PUSHs(TARG);
RETURN;
}
little = POPs;
big = POPs;
tmps = SvPV(big, biglen);
- if (IN_UTF8 && offset > 0)
+ if (offset > 0 && DO_UTF8(big))
sv_pos_u2b(big, &offset, 0);
if (offset < 0)
offset = 0;
retval = -1;
else
retval = tmps2 - tmps;
- if (IN_UTF8 && retval > 0)
+ if (retval > 0 && DO_UTF8(big))
sv_pos_b2u(big, &retval);
PUSHi(retval + arybase);
RETURN;
if (MAXARG < 3)
offset = blen;
else {
- if (IN_UTF8 && offset > 0)
+ if (offset > 0 && DO_UTF8(big))
sv_pos_u2b(big, &offset, 0);
offset = offset - arybase + llen;
}
retval = -1;
else
retval = tmps2 - tmps;
- if (IN_UTF8 && retval > 0)
+ if (retval > 0 && DO_UTF8(big))
sv_pos_b2u(big, &retval);
PUSHi(retval + arybase);
RETURN;
PP(pp_sprintf)
{
djSP; dMARK; dORIGMARK; dTARGET;
-#ifdef USE_LOCALE_NUMERIC
- if (PL_op->op_private & OPpLOCALE)
- SET_NUMERIC_LOCAL();
- else
- SET_NUMERIC_STANDARD();
-#endif
do_sprintf(TARG, SP-MARK, MARK+1);
TAINT_IF(SvTAINTED(TARG));
SP = ORIGMARK;
djSP; dTARGET;
UV value;
STRLEN n_a;
- U8 *tmps = (U8*)POPpx;
+ SV *tmpsv = POPs;
+ U8 *tmps = (U8*)SvPVx(tmpsv,n_a);
I32 retlen;
- if (IN_UTF8 && (*tmps & 0x80))
+ if ((*tmps & 0x80) && DO_UTF8(tmpsv))
value = utf8_to_uv(tmps, &retlen);
else
value = (UV)(*tmps & 255);
(void)SvUPGRADE(TARG,SVt_PV);
- if (IN_UTF8 && value >= 128) {
+ if (value > 255 && !IN_BYTE) {
SvGROW(TARG,8);
tmps = SvPVX(TARG);
tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value);
SvCUR_set(TARG, tmps - SvPVX(TARG));
*tmps = '\0';
+ SvUTF8_on(TARG);
(void)SvPOK_only(TARG);
XPUSHs(TARG);
RETURN;
tmps = SvPVX(TARG);
*tmps++ = value;
*tmps = '\0';
+ SvUTF8_off(TARG); /* decontaminate */
(void)SvPOK_only(TARG);
XPUSHs(TARG);
RETURN;
sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
#endif
#else
- DIE(
+ DIE(aTHX_
"The crypt() function is unimplemented due to excessive paranoia.");
#endif
SETs(TARG);
register U8 *s;
STRLEN slen;
- if (IN_UTF8 && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
+ if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
I32 ulen;
U8 tmpbuf[10];
U8 *tend;
tend = uv_to_utf8(tmpbuf, uv);
- if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+ if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
dTARGET;
sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
+ SvUTF8_on(TARG);
SETs(TARG);
}
else {
s = (U8*)SvPV_force(sv, slen);
Copy(tmpbuf, s, ulen, U8);
}
- RETURN;
}
-
- if (!SvPADTMP(sv)) {
- dTARGET;
- sv_setsv(TARG, sv);
- sv = TARG;
- SETs(sv);
- }
- s = (U8*)SvPV_force(sv, slen);
- if (*s) {
- if (PL_op->op_private & OPpLOCALE) {
- TAINT;
- SvTAINTED_on(sv);
- *s = toUPPER_LC(*s);
+ else {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
+ dTARGET;
+ SvUTF8_off(TARG); /* decontaminate */
+ sv_setsv(TARG, sv);
+ sv = TARG;
+ SETs(sv);
+ }
+ s = (U8*)SvPV_force(sv, slen);
+ if (*s) {
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ *s = toUPPER_LC(*s);
+ }
+ else
+ *s = toUPPER(*s);
}
- else
- *s = toUPPER(*s);
}
-
+ if (SvSMAGICAL(sv))
+ mg_set(sv);
RETURN;
}
register U8 *s;
STRLEN slen;
- if (IN_UTF8 && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
+ if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
I32 ulen;
U8 tmpbuf[10];
U8 *tend;
tend = uv_to_utf8(tmpbuf, uv);
- if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+ if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
dTARGET;
sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
+ SvUTF8_on(TARG);
SETs(TARG);
}
else {
s = (U8*)SvPV_force(sv, slen);
Copy(tmpbuf, s, ulen, U8);
}
- RETURN;
}
-
- if (!SvPADTMP(sv)) {
- dTARGET;
- sv_setsv(TARG, sv);
- sv = TARG;
- SETs(sv);
- }
- s = (U8*)SvPV_force(sv, slen);
- if (*s) {
- if (PL_op->op_private & OPpLOCALE) {
- TAINT;
- SvTAINTED_on(sv);
- *s = toLOWER_LC(*s);
+ else {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
+ dTARGET;
+ SvUTF8_off(TARG); /* decontaminate */
+ sv_setsv(TARG, sv);
+ sv = TARG;
+ SETs(sv);
+ }
+ s = (U8*)SvPV_force(sv, slen);
+ if (*s) {
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ *s = toLOWER_LC(*s);
+ }
+ else
+ *s = toLOWER(*s);
}
- else
- *s = toLOWER(*s);
}
-
- SETs(sv);
+ if (SvSMAGICAL(sv))
+ mg_set(sv);
RETURN;
}
register U8 *s;
STRLEN len;
- if (IN_UTF8) {
+ if (DO_UTF8(sv)) {
dTARGET;
I32 ulen;
register U8 *d;
s = (U8*)SvPV(sv,len);
if (!len) {
+ SvUTF8_off(TARG); /* decontaminate */
sv_setpvn(TARG, "", 0);
SETs(TARG);
- RETURN;
- }
-
- (void)SvUPGRADE(TARG, SVt_PV);
- SvGROW(TARG, (len * 2) + 1);
- (void)SvPOK_only(TARG);
- d = (U8*)SvPVX(TARG);
- send = s + len;
- if (PL_op->op_private & OPpLOCALE) {
- TAINT;
- SvTAINTED_on(TARG);
- while (s < send) {
- d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
- s += ulen;
- }
}
else {
- while (s < send) {
- d = uv_to_utf8(d, toUPPER_utf8( s ));
- s += UTF8SKIP(s);
+ (void)SvUPGRADE(TARG, SVt_PV);
+ SvGROW(TARG, (len * 2) + 1);
+ (void)SvPOK_only(TARG);
+ d = (U8*)SvPVX(TARG);
+ send = s + len;
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(TARG);
+ while (s < send) {
+ d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
+ s += ulen;
+ }
+ }
+ else {
+ while (s < send) {
+ d = uv_to_utf8(d, toUPPER_utf8( s ));
+ s += UTF8SKIP(s);
+ }
}
+ *d = '\0';
+ SvUTF8_on(TARG);
+ SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+ SETs(TARG);
}
- *d = '\0';
- SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
- SETs(TARG);
- RETURN;
}
-
- if (!SvPADTMP(sv)) {
- dTARGET;
- sv_setsv(TARG, sv);
- sv = TARG;
- SETs(sv);
- }
-
- s = (U8*)SvPV_force(sv, len);
- if (len) {
- register U8 *send = s + len;
-
- if (PL_op->op_private & OPpLOCALE) {
- TAINT;
- SvTAINTED_on(sv);
- for (; s < send; s++)
- *s = toUPPER_LC(*s);
+ else {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
+ dTARGET;
+ SvUTF8_off(TARG); /* decontaminate */
+ sv_setsv(TARG, sv);
+ sv = TARG;
+ SETs(sv);
}
- else {
- for (; s < send; s++)
- *s = toUPPER(*s);
+ s = (U8*)SvPV_force(sv, len);
+ if (len) {
+ register U8 *send = s + len;
+
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ for (; s < send; s++)
+ *s = toUPPER_LC(*s);
+ }
+ else {
+ for (; s < send; s++)
+ *s = toUPPER(*s);
+ }
}
}
+ if (SvSMAGICAL(sv))
+ mg_set(sv);
RETURN;
}
register U8 *s;
STRLEN len;
- if (IN_UTF8) {
+ if (DO_UTF8(sv)) {
dTARGET;
I32 ulen;
register U8 *d;
s = (U8*)SvPV(sv,len);
if (!len) {
+ SvUTF8_off(TARG); /* decontaminate */
sv_setpvn(TARG, "", 0);
SETs(TARG);
- RETURN;
- }
-
- (void)SvUPGRADE(TARG, SVt_PV);
- SvGROW(TARG, (len * 2) + 1);
- (void)SvPOK_only(TARG);
- d = (U8*)SvPVX(TARG);
- send = s + len;
- if (PL_op->op_private & OPpLOCALE) {
- TAINT;
- SvTAINTED_on(TARG);
- while (s < send) {
- d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
- s += ulen;
- }
}
else {
- while (s < send) {
- d = uv_to_utf8(d, toLOWER_utf8(s));
- s += UTF8SKIP(s);
+ (void)SvUPGRADE(TARG, SVt_PV);
+ SvGROW(TARG, (len * 2) + 1);
+ (void)SvPOK_only(TARG);
+ d = (U8*)SvPVX(TARG);
+ send = s + len;
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(TARG);
+ while (s < send) {
+ d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
+ s += ulen;
+ }
}
+ else {
+ while (s < send) {
+ d = uv_to_utf8(d, toLOWER_utf8(s));
+ s += UTF8SKIP(s);
+ }
+ }
+ *d = '\0';
+ SvUTF8_on(TARG);
+ SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+ SETs(TARG);
}
- *d = '\0';
- SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
- SETs(TARG);
- RETURN;
- }
-
- if (!SvPADTMP(sv)) {
- dTARGET;
- sv_setsv(TARG, sv);
- sv = TARG;
- SETs(sv);
}
+ else {
+ if (!SvPADTMP(sv) || SvREADONLY(sv)) {
+ dTARGET;
+ SvUTF8_off(TARG); /* decontaminate */
+ sv_setsv(TARG, sv);
+ sv = TARG;
+ SETs(sv);
+ }
- s = (U8*)SvPV_force(sv, len);
- if (len) {
- register U8 *send = s + len;
+ s = (U8*)SvPV_force(sv, len);
+ if (len) {
+ register U8 *send = s + len;
- if (PL_op->op_private & OPpLOCALE) {
- TAINT;
- SvTAINTED_on(sv);
- for (; s < send; s++)
- *s = toLOWER_LC(*s);
- }
- else {
- for (; s < send; s++)
- *s = toLOWER(*s);
+ if (PL_op->op_private & OPpLOCALE) {
+ TAINT;
+ SvTAINTED_on(sv);
+ for (; s < send; s++)
+ *s = toLOWER_LC(*s);
+ }
+ else {
+ for (; s < send; s++)
+ *s = toLOWER(*s);
+ }
}
}
+ if (SvSMAGICAL(sv))
+ mg_set(sv);
RETURN;
}
register char *s = SvPV(sv,len);
register char *d;
+ SvUTF8_off(TARG); /* decontaminate */
if (len) {
(void)SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, (len * 2) + 1);
d = SvPVX(TARG);
- if (IN_UTF8) {
+ if (DO_UTF8(sv)) {
while (len) {
if (*s & 0x80) {
STRLEN ulen = UTF8SKIP(s);
len--;
}
}
+ SvUTF8_on(TARG);
}
else {
while (len--) {
else
sv_setpvn(TARG, s, len);
SETs(TARG);
+ if (SvSMAGICAL(TARG))
+ mg_set(TARG);
RETURN;
}
svp = av_fetch(av, elem, lval);
if (lval) {
if (!svp || *svp == &PL_sv_undef)
- DIE(PL_no_aelem, elem);
+ DIE(aTHX_ PL_no_aelem, elem);
if (PL_op->op_private & OPpLVAL_INTRO)
save_aelem(av, elem, svp);
}
PP(pp_each)
{
- djSP; dTARGET;
+ djSP;
HV *hash = (HV*)POPs;
HE *entry;
I32 gimme = GIMME_V;
if (entry) {
PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
if (gimme == G_ARRAY) {
+ SV *val;
PUTBACK;
/* might clobber stack_sp */
- sv_setsv(TARG, realhv ?
- hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry));
+ val = realhv ?
+ hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
SPAGAIN;
- PUSHs(TARG);
+ PUSHs(val);
}
}
else if (gimme == G_SCALAR)
PP(pp_values)
{
- return do_kv(ARGS);
+ return do_kv();
}
PP(pp_keys)
{
- return do_kv(ARGS);
+ return do_kv();
}
PP(pp_delete)
U32 hvtype;
hv = (HV*)POPs;
hvtype = SvTYPE(hv);
- while (++MARK <= SP) {
- if (hvtype == SVt_PVHV)
+ if (hvtype == SVt_PVHV) { /* hash element */
+ while (++MARK <= SP) {
sv = hv_delete_ent(hv, *MARK, discard, 0);
- else
- DIE("Not a HASH reference");
- *MARK = sv ? sv : &PL_sv_undef;
+ *MARK = sv ? sv : &PL_sv_undef;
+ }
}
+ else if (hvtype == SVt_PVAV) {
+ if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
+ while (++MARK <= SP) {
+ sv = av_delete((AV*)hv, SvIV(*MARK), discard);
+ *MARK = sv ? sv : &PL_sv_undef;
+ }
+ }
+ else { /* pseudo-hash element */
+ while (++MARK <= SP) {
+ sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
+ *MARK = sv ? sv : &PL_sv_undef;
+ }
+ }
+ }
+ else
+ DIE(aTHX_ "Not a HASH reference");
if (discard)
SP = ORIGMARK;
else if (gimme == G_SCALAR) {
hv = (HV*)POPs;
if (SvTYPE(hv) == SVt_PVHV)
sv = hv_delete_ent(hv, keysv, discard, 0);
+ else if (SvTYPE(hv) == SVt_PVAV) {
+ if (PL_op->op_flags & OPf_SPECIAL)
+ sv = av_delete((AV*)hv, SvIV(keysv), discard);
+ else
+ sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
+ }
else
- DIE("Not a HASH reference");
+ DIE(aTHX_ "Not a HASH reference");
if (!sv)
sv = &PL_sv_undef;
if (!discard)
PP(pp_exists)
{
djSP;
- SV *tmpsv = POPs;
- HV *hv = (HV*)POPs;
+ SV *tmpsv;
+ HV *hv;
+
+ if (PL_op->op_private & OPpEXISTS_SUB) {
+ GV *gv;
+ CV *cv;
+ SV *sv = POPs;
+ cv = sv_2cv(sv, &hv, &gv, FALSE);
+ if (cv)
+ RETPUSHYES;
+ if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
+ RETPUSHYES;
+ RETPUSHNO;
+ }
+ tmpsv = POPs;
+ hv = (HV*)POPs;
if (SvTYPE(hv) == SVt_PVHV) {
if (hv_exists_ent(hv, tmpsv, 0))
RETPUSHYES;
}
else if (SvTYPE(hv) == SVt_PVAV) {
- if (avhv_exists_ent((AV*)hv, tmpsv, 0))
+ if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
+ if (av_exists((AV*)hv, SvIV(tmpsv)))
+ RETPUSHYES;
+ }
+ else if (avhv_exists_ent((AV*)hv, tmpsv, 0)) /* pseudo-hash element */
RETPUSHYES;
}
else {
- DIE("Not a HASH reference");
+ DIE(aTHX_ "Not a HASH reference");
}
RETPUSHNO;
}
I32 realhv = (SvTYPE(hv) == SVt_PVHV);
if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
- DIE("Can't localize pseudo-hash element");
+ DIE(aTHX_ "Can't localize pseudo-hash element");
if (realhv || SvTYPE(hv) == SVt_PVAV) {
while (++MARK <= SP) {
if (lval) {
if (!svp || *svp == &PL_sv_undef) {
STRLEN n_a;
- DIE(PL_no_helem, SvPV(keysv, n_a));
+ DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
}
if (PL_op->op_private & OPpLVAL_INTRO)
save_helem(hv, keysv, svp);
for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
ix = SvIVx(*lelem);
- if (ix < 0) {
+ if (ix < 0)
ix += max;
- if (ix < 0)
- *lelem = &PL_sv_undef;
- else if (!(*lelem = firstrelem[ix]))
- *lelem = &PL_sv_undef;
- }
- else {
+ else
ix -= arybase;
- if (ix >= max || !(*lelem = firstrelem[ix]))
+ if (ix < 0 || ix >= max)
+ *lelem = &PL_sv_undef;
+ else {
+ is_something_there = TRUE;
+ if (!(*lelem = firstrelem[ix]))
*lelem = &PL_sv_undef;
}
- if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem)))
- is_something_there = TRUE;
}
if (is_something_there)
SP = lastlelem;
if (MARK < SP)
sv_setsv(val, *++MARK);
else if (ckWARN(WARN_UNSAFE))
- warner(WARN_UNSAFE, "Odd number of elements in hash assignment");
+ Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment");
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
PUSHMARK(MARK);
PUTBACK;
ENTER;
- perl_call_method("SPLICE",GIMME_V);
+ call_method("SPLICE",GIMME_V);
LEAVE;
SPAGAIN;
RETURN;
else
offset -= PL_curcop->cop_arybase;
if (offset < 0)
- DIE(PL_no_aelem, i);
+ DIE(aTHX_ PL_no_aelem, i);
if (++MARK < SP) {
length = SvIVx(*MARK++);
if (length < 0) {
PUSHMARK(MARK);
PUTBACK;
ENTER;
- perl_call_method("PUSH",G_SCALAR|G_DISCARD);
+ call_method("PUSH",G_SCALAR|G_DISCARD);
LEAVE;
SPAGAIN;
}
PUSHMARK(MARK);
PUTBACK;
ENTER;
- perl_call_method("UNSHIFT",G_SCALAR|G_DISCARD);
+ call_method("UNSHIFT",G_SCALAR|G_DISCARD);
LEAVE;
SPAGAIN;
}
*MARK++ = *SP;
*SP-- = tmp;
}
+ /* safe as long as stack cannot get extended in the above */
SP = oldsp;
}
else {
dTARGET;
STRLEN len;
+ SvUTF8_off(TARG); /* decontaminate */
if (SP - MARK > 1)
do_join(TARG, &PL_sv_no, MARK, SP);
else
sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
up = SvPV_force(TARG, len);
if (len > 1) {
- if (IN_UTF8) { /* first reverse each character */
+ if (DO_UTF8(TARG)) { /* first reverse each character */
U8* s = (U8*)SvPVX(TARG);
U8* send = (U8*)(s + len);
while (s < send) {
s += UTF8SKIP(s);
down = (char*)(s - 1);
if (s > send || !((*down & 0xc0) == 0x80)) {
- warn("Malformed UTF-8 character");
+ if (ckWARN_d(WARN_UTF8))
+ Perl_warner(aTHX_ WARN_UTF8,
+ "Malformed UTF-8 character");
break;
}
while (down > up) {
RETURN;
}
-STATIC SV *
-mul128(SV *sv, U8 m)
+STATIC SV *
+S_mul128(pTHX_ SV *sv, U8 m)
{
STRLEN len;
char *s = SvPV(sv, len);
{
djSP;
dPOPPOPssrl;
- SV **oldsp = SP;
+ I32 start_sp_offset = SP - PL_stack_base;
I32 gimme = GIMME_V;
SV *sv;
STRLEN llen;
I32 datumtype;
register I32 len;
register I32 bits;
+ register char *str;
/* These must not be in registers: */
I16 ashort;
double adouble;
I32 checksum = 0;
register U32 culong;
- double cdouble;
+ NV cdouble;
int commas = 0;
+ int star;
#ifdef PERL_NATINT_PACK
int natint; /* native integer */
int unatint; /* unsigned native integer */
#endif
if (isSPACE(datumtype))
continue;
+ if (datumtype == '#') {
+ while (pat < patend && *pat != '\n')
+ pat++;
+ continue;
+ }
if (*pat == '!') {
char *natstr = "sSiIlL";
pat++;
}
else
- croak("'!' allowed only after types %s", natstr);
+ DIE(aTHX_ "'!' allowed only after types %s", natstr);
}
+ star = 0;
if (pat >= patend)
len = 1;
else if (*pat == '*') {
len = strend - strbeg; /* long enough */
pat++;
+ star = 1;
}
else if (isDIGIT(*pat)) {
len = *pat++ - '0';
- while (isDIGIT(*pat))
+ while (isDIGIT(*pat)) {
len = (len * 10) + (*pat++ - '0');
+ if (len < 0)
+ DIE(aTHX_ "Repeat count in unpack overflows");
+ }
}
else
len = (datumtype != '@');
+ redo_switch:
switch(datumtype) {
default:
- croak("Invalid type in unpack: '%c'", (int)datumtype);
+ DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
if (commas++ == 0 && ckWARN(WARN_UNSAFE))
- warner(WARN_UNSAFE, "Invalid type in unpack: '%c'", (int)datumtype);
+ Perl_warner(aTHX_ WARN_UNSAFE,
+ "Invalid type in unpack: '%c'", (int)datumtype);
break;
case '%':
if (len == 1 && pat[-1] != '1')
break;
case '@':
if (len > strend - strbeg)
- DIE("@ outside of string");
+ DIE(aTHX_ "@ outside of string");
s = strbeg + len;
break;
case 'X':
if (len > s - strbeg)
- DIE("X outside of string");
+ DIE(aTHX_ "X outside of string");
s -= len;
break;
case 'x':
if (len > strend - s)
- DIE("x outside of string");
+ DIE(aTHX_ "x outside of string");
s += len;
break;
+ case '/':
+ if (start_sp_offset >= SP - PL_stack_base)
+ DIE(aTHX_ "/ must follow a numeric type");
+ datumtype = *pat++;
+ if (*pat == '*')
+ pat++; /* ignore '*' for compatibility with pack */
+ if (isDIGIT(*pat))
+ DIE(aTHX_ "/ cannot take a count" );
+ len = POPi;
+ star = 0;
+ goto redo_switch;
case 'A':
case 'Z':
case 'a':
break;
case 'B':
case 'b':
- if (pat[-1] == '*' || len > (strend - s) * 8)
+ if (star || len > (strend - s) * 8)
len = (strend - s) * 8;
if (checksum) {
if (!PL_bitcount) {
sv = NEWSV(35, len + 1);
SvCUR_set(sv, len);
SvPOK_on(sv);
- aptr = pat; /* borrow register */
- pat = SvPVX(sv);
+ str = SvPVX(sv);
if (datumtype == 'b') {
aint = len;
for (len = 0; len < aint; len++) {
bits >>= 1;
else
bits = *s++;
- *pat++ = '0' + (bits & 1);
+ *str++ = '0' + (bits & 1);
}
}
else {
bits <<= 1;
else
bits = *s++;
- *pat++ = '0' + ((bits & 128) != 0);
+ *str++ = '0' + ((bits & 128) != 0);
}
}
- *pat = '\0';
- pat = aptr; /* unborrow register */
+ *str = '\0';
XPUSHs(sv_2mortal(sv));
break;
case 'H':
case 'h':
- if (pat[-1] == '*' || len > (strend - s) * 2)
+ if (star || len > (strend - s) * 2)
len = (strend - s) * 2;
sv = NEWSV(35, len + 1);
SvCUR_set(sv, len);
SvPOK_on(sv);
- aptr = pat; /* borrow register */
- pat = SvPVX(sv);
+ str = SvPVX(sv);
if (datumtype == 'h') {
aint = len;
for (len = 0; len < aint; len++) {
bits >>= 4;
else
bits = *s++;
- *pat++ = PL_hexdigit[bits & 15];
+ *str++ = PL_hexdigit[bits & 15];
}
}
else {
bits <<= 4;
else
bits = *s++;
- *pat++ = PL_hexdigit[(bits >> 4) & 15];
+ *str++ = PL_hexdigit[(bits >> 4) & 15];
}
}
- *pat = '\0';
- pat = aptr; /* unborrow register */
+ *str = '\0';
XPUSHs(sv_2mortal(sv));
break;
case 'c':
auint = utf8_to_uv((U8*)s, &along);
s += along;
if (checksum > 32)
- cdouble += (double)auint;
+ cdouble += (NV)auint;
else
culong += auint;
}
if (checksum) {
#if SHORTSIZE != SIZE16
if (natint) {
+ short ashort;
while (len-- > 0) {
COPYNN(s, &ashort, sizeof(short));
s += sizeof(short);
EXTEND_MORTAL(len);
#if SHORTSIZE != SIZE16
if (natint) {
+ short ashort;
while (len-- > 0) {
COPYNN(s, &ashort, sizeof(short));
s += sizeof(short);
if (checksum) {
#if SHORTSIZE != SIZE16
if (unatint) {
+ unsigned short aushort;
while (len-- > 0) {
COPYNN(s, &aushort, sizeof(unsigned short));
s += sizeof(unsigned short);
EXTEND_MORTAL(len);
#if SHORTSIZE != SIZE16
if (unatint) {
+ unsigned short aushort;
while (len-- > 0) {
COPYNN(s, &aushort, sizeof(unsigned short));
s += sizeof(unsigned short);
Copy(s, &aint, 1, int);
s += sizeof(int);
if (checksum > 32)
- cdouble += (double)aint;
+ cdouble += (NV)aint;
else
culong += aint;
}
Copy(s, &auint, 1, unsigned int);
s += sizeof(unsigned int);
if (checksum > 32)
- cdouble += (double)auint;
+ cdouble += (NV)auint;
else
culong += auint;
}
if (checksum) {
#if LONGSIZE != SIZE32
if (natint) {
+ long along;
while (len-- > 0) {
COPYNN(s, &along, sizeof(long));
s += sizeof(long);
if (checksum > 32)
- cdouble += (double)along;
+ cdouble += (NV)along;
else
culong += along;
}
#endif
s += SIZE32;
if (checksum > 32)
- cdouble += (double)along;
+ cdouble += (NV)along;
else
culong += along;
}
EXTEND_MORTAL(len);
#if LONGSIZE != SIZE32
if (natint) {
+ long along;
while (len-- > 0) {
COPYNN(s, &along, sizeof(long));
s += sizeof(long);
if (checksum) {
#if LONGSIZE != SIZE32
if (unatint) {
+ unsigned long aulong;
while (len-- > 0) {
COPYNN(s, &aulong, sizeof(unsigned long));
s += sizeof(unsigned long);
if (checksum > 32)
- cdouble += (double)aulong;
+ cdouble += (NV)aulong;
else
culong += aulong;
}
aulong = vtohl(aulong);
#endif
if (checksum > 32)
- cdouble += (double)aulong;
+ cdouble += (NV)aulong;
else
culong += aulong;
}
EXTEND_MORTAL(len);
#if LONGSIZE != SIZE32
if (unatint) {
+ unsigned long aulong;
while (len-- > 0) {
COPYNN(s, &aulong, sizeof(unsigned long));
s += sizeof(unsigned long);
char *t;
STRLEN n_a;
- sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
+ sv = Perl_newSVpvf(aTHX_ "%.*Vu", (int)TYPE_DIGITS(UV), auv);
while (s < strend) {
sv = mul128(sv, *s & 0x7f);
if (!(*s++ & 0x80)) {
}
}
if ((s >= strend) && bytes)
- croak("Unterminated compressed integer");
+ DIE(aTHX_ "Unterminated compressed integer");
}
break;
case 'P':
if (aquad >= IV_MIN && aquad <= IV_MAX)
sv_setiv(sv, (IV)aquad);
else
- sv_setnv(sv, (double)aquad);
+ sv_setnv(sv, (NV)aquad);
PUSHs(sv_2mortal(sv));
}
break;
if (auquad <= UV_MAX)
sv_setuv(sv, (UV)auquad);
else
- sv_setnv(sv, (double)auquad);
+ sv_setnv(sv, (NV)auquad);
PUSHs(sv_2mortal(sv));
}
break;
Copy(s, &afloat, 1, float);
s += sizeof(float);
sv = NEWSV(47, 0);
- sv_setnv(sv, (double)afloat);
+ sv_setnv(sv, (NV)afloat);
PUSHs(sv_2mortal(sv));
}
}
Copy(s, &adouble, 1, double);
s += sizeof(double);
sv = NEWSV(48, 0);
- sv_setnv(sv, (double)adouble);
+ sv_setnv(sv, (NV)adouble);
PUSHs(sv_2mortal(sv));
}
}
sv = NEWSV(42, 0);
if (strchr("fFdD", datumtype) ||
(checksum > 32 && strchr("iIlLNU", datumtype)) ) {
- double trouble;
+ NV trouble;
adouble = 1.0;
while (checksum >= 16) {
along = (1 << checksum) - 1;
while (cdouble < 0.0)
cdouble += adouble;
- cdouble = modf(cdouble / adouble, &trouble) * adouble;
+ cdouble = Perl_modf(cdouble / adouble, &trouble) * adouble;
sv_setnv(sv, cdouble);
}
else {
checksum = 0;
}
}
- if (SP == oldsp && gimme == G_SCALAR)
+ if (SP - PL_stack_base == start_sp_offset && gimme == G_SCALAR)
PUSHs(&PL_sv_undef);
RETURN;
}
STATIC void
-doencodes(register SV *sv, register char *s, register I32 len)
+S_doencodes(pTHX_ register SV *sv, register char *s, register I32 len)
{
char hunk[5];
}
STATIC SV *
-is_an_int(char *s, STRLEN l)
+S_is_an_int(pTHX_ char *s, STRLEN l)
{
STRLEN n_a;
SV *result = newSVpvn(s, l);
return (result);
}
+/* pnum must be '\0' terminated */
STATIC int
-div128(SV *pnum, bool *done)
- /* must be '\0' terminated */
-
+S_div128(pTHX_ SV *pnum, bool *done)
{
STRLEN len;
char *s = SvPV(pnum, len);
MARK++;
sv_setpvn(cat, "", 0);
while (pat < patend) {
-#define NEXTFROM (items-- > 0 ? *MARK++ : &PL_sv_no)
+ SV *lengthcode = Nullsv;
+#define NEXTFROM ( lengthcode ? lengthcode : items-- > 0 ? *MARK++ : &PL_sv_no)
datumtype = *pat++ & 0xFF;
#ifdef PERL_NATINT_PACK
natint = 0;
#endif
if (isSPACE(datumtype))
continue;
+ if (datumtype == '#') {
+ while (pat < patend && *pat != '\n')
+ pat++;
+ continue;
+ }
if (*pat == '!') {
char *natstr = "sSiIlL";
pat++;
}
else
- croak("'!' allowed only after types %s", natstr);
+ DIE(aTHX_ "'!' allowed only after types %s", natstr);
}
if (*pat == '*') {
len = strchr("@Xxu", datumtype) ? 0 : items;
}
else if (isDIGIT(*pat)) {
len = *pat++ - '0';
- while (isDIGIT(*pat))
+ while (isDIGIT(*pat)) {
len = (len * 10) + (*pat++ - '0');
+ if (len < 0)
+ DIE(aTHX_ "Repeat count in pack overflows");
+ }
}
else
len = 1;
+ if (*pat == '/') {
+ ++pat;
+ if (*pat != 'a' && *pat != 'A' && *pat != 'Z' || pat[1] != '*')
+ DIE(aTHX_ "/ must be followed by a*, A* or Z*");
+ lengthcode = sv_2mortal(newSViv(sv_len(items > 0
+ ? *MARK : &PL_sv_no)));
+ }
switch(datumtype) {
default:
- croak("Invalid type in pack: '%c'", (int)datumtype);
+ DIE(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
case ',': /* grandfather in commas but with a warning */
if (commas++ == 0 && ckWARN(WARN_UNSAFE))
- warner(WARN_UNSAFE, "Invalid type in pack: '%c'", (int)datumtype);
+ Perl_warner(aTHX_ WARN_UNSAFE,
+ "Invalid type in pack: '%c'", (int)datumtype);
break;
case '%':
- DIE("%% may only be used in unpack");
+ DIE(aTHX_ "%% may only be used in unpack");
case '@':
len -= SvCUR(cat);
if (len > 0)
case 'X':
shrink:
if (SvCUR(cat) < len)
- DIE("X outside of string");
+ DIE(aTHX_ "X outside of string");
SvCUR(cat) -= len;
*SvEND(cat) = '\0';
break;
case 'a':
fromstr = NEXTFROM;
aptr = SvPV(fromstr, fromlen);
- if (pat[-1] == '*')
+ if (pat[-1] == '*') {
len = fromlen;
- if (fromlen > len)
+ if (datumtype == 'Z')
+ ++len;
+ }
+ if (fromlen >= len) {
sv_catpvn(cat, aptr, len);
+ if (datumtype == 'Z')
+ *(SvEND(cat)-1) = '\0';
+ }
else {
sv_catpvn(cat, aptr, fromlen);
len -= fromlen;
case 'B':
case 'b':
{
- char *savepat = pat;
+ register char *str;
I32 saveitems;
fromstr = NEXTFROM;
saveitems = items;
- aptr = SvPV(fromstr, fromlen);
+ str = SvPV(fromstr, fromlen);
if (pat[-1] == '*')
len = fromlen;
- pat = aptr;
aint = SvCUR(cat);
SvCUR(cat) += (len+7)/8;
SvGROW(cat, SvCUR(cat) + 1);
items = 0;
if (datumtype == 'B') {
for (len = 0; len++ < aint;) {
- items |= *pat++ & 1;
+ items |= *str++ & 1;
if (len & 7)
items <<= 1;
else {
}
else {
for (len = 0; len++ < aint;) {
- if (*pat++ & 1)
+ if (*str++ & 1)
items |= 128;
if (len & 7)
items >>= 1;
items >>= 7 - (aint & 7);
*aptr++ = items & 0xff;
}
- pat = SvPVX(cat) + SvCUR(cat);
- while (aptr <= pat)
+ str = SvPVX(cat) + SvCUR(cat);
+ while (aptr <= str)
*aptr++ = '\0';
- pat = savepat;
items = saveitems;
}
break;
case 'H':
case 'h':
{
- char *savepat = pat;
+ register char *str;
I32 saveitems;
fromstr = NEXTFROM;
saveitems = items;
- aptr = SvPV(fromstr, fromlen);
+ str = SvPV(fromstr, fromlen);
if (pat[-1] == '*')
len = fromlen;
- pat = aptr;
aint = SvCUR(cat);
SvCUR(cat) += (len+1)/2;
SvGROW(cat, SvCUR(cat) + 1);
items = 0;
if (datumtype == 'H') {
for (len = 0; len++ < aint;) {
- if (isALPHA(*pat))
- items |= ((*pat++ & 15) + 9) & 15;
+ if (isALPHA(*str))
+ items |= ((*str++ & 15) + 9) & 15;
else
- items |= *pat++ & 15;
+ items |= *str++ & 15;
if (len & 1)
items <<= 4;
else {
}
else {
for (len = 0; len++ < aint;) {
- if (isALPHA(*pat))
- items |= (((*pat++ & 15) + 9) & 15) << 4;
+ if (isALPHA(*str))
+ items |= (((*str++ & 15) + 9) & 15) << 4;
else
- items |= (*pat++ & 15) << 4;
+ items |= (*str++ & 15) << 4;
if (len & 1)
items >>= 4;
else {
}
if (aint & 1)
*aptr++ = items & 0xff;
- pat = SvPVX(cat) + SvCUR(cat);
- while (aptr <= pat)
+ str = SvPVX(cat) + SvCUR(cat);
+ while (aptr <= str)
*aptr++ = '\0';
- pat = savepat;
items = saveitems;
}
break;
case 's':
#if SHORTSIZE != SIZE16
if (natint) {
+ short ashort;
+
while (len-- > 0) {
fromstr = NEXTFROM;
ashort = SvIV(fromstr);
case 'w':
while (len-- > 0) {
fromstr = NEXTFROM;
- adouble = floor(SvNV(fromstr));
+ adouble = Perl_floor(SvNV(fromstr));
if (adouble < 0)
- croak("Cannot compress negative numbers");
+ DIE(aTHX_ "Cannot compress negative numbers");
if (
#ifdef BW_BITS
{
char buf[1 + sizeof(UV)];
char *in = buf + sizeof(buf);
- UV auv = U_V(adouble);;
+ UV auv = U_V(adouble);
do {
*--in = (auv & 0x7f) | 0x80;
/* Copy string and check for compliance */
from = SvPV(fromstr, len);
if ((norm = is_an_int(from, len)) == NULL)
- croak("can compress only unsigned integer");
+ DIE(aTHX_ "can compress only unsigned integer");
New('w', result, len, char);
in = result + len;
double next = floor(adouble / 128);
*--in = (unsigned char)(adouble - (next * 128)) | 0x80;
if (--in < buf) /* this cannot happen ;-) */
- croak ("Cannot compress integer");
+ DIE(aTHX_ "Cannot compress integer");
adouble = next;
} while (adouble > 0);
buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
}
else
- croak("Cannot compress non integer");
+ DIE(aTHX_ "Cannot compress non integer");
}
break;
case 'i':
case 'L':
#if LONGSIZE != SIZE32
if (natint) {
+ unsigned long aulong;
+
while (len-- > 0) {
fromstr = NEXTFROM;
aulong = SvUV(fromstr);
case 'l':
#if LONGSIZE != SIZE32
if (natint) {
+ long along;
+
while (len-- > 0) {
fromstr = NEXTFROM;
along = SvIV(fromstr);
case 'Q':
while (len-- > 0) {
fromstr = NEXTFROM;
- auquad = (Uquad_t)SvIV(fromstr);
+ auquad = (Uquad_t)SvUV(fromstr);
sv_catpvn(cat, (char*)&auquad, sizeof(Uquad_t));
}
break;
sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
}
break;
-#endif /* HAS_QUAD */
+#endif
case 'P':
len = 1; /* assume SV is correct length */
/* FALL THROUGH */
* of pack() (and all copies of the result) are
* gone.
*/
- if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
- warner(WARN_UNSAFE,
+ if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr)
+ || (SvPADTMP(fromstr)
+ && !SvREADONLY(fromstr))))
+ {
+ Perl_warner(aTHX_ WARN_UNSAFE,
"Attempt to pack pointer to temporary value");
+ }
if (SvPOK(fromstr) || SvNIOK(fromstr))
aptr = SvPV(fromstr,n_a);
else
pm = (PMOP*)POPs;
#endif
if (!pm || !s)
- DIE("panic: do_split");
+ DIE(aTHX_ "panic: do_split");
rx = pm->op_pmregexp;
TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
(pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
- if (pm->op_pmreplroot)
+ if (pm->op_pmreplroot) {
+#ifdef USE_ITHREADS
+ ary = GvAVn((GV*)PL_curpad[(PADOFFSET)pm->op_pmreplroot]);
+#else
ary = GvAVn((GV*)pm->op_pmreplroot);
+#endif
+ }
else if (gimme != G_ARRAY)
#ifdef USE_THREADS
ary = (AV*)PL_curpad[0];
else {
if (!AvREAL(ary)) {
AvREAL_on(ary);
+ AvREIFY_off(ary);
for (i = AvFILLp(ary); i >= 0; i--)
AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */
}
s = m;
}
}
- else if (rx->check_substr && !rx->nparens
+ else if ((rx->reganch & RE_USE_INTUIT) && !rx->nparens
&& (rx->reganch & ROPT_CHECK_ALL)
&& !(rx->reganch & ROPT_ANCH)) {
- i = SvCUR(rx->check_substr);
- if (i == 1 && !SvTAIL(rx->check_substr)) {
- i = *SvPVX(rx->check_substr);
+ int tail = (rx->reganch & RE_INTUIT_TAIL);
+ SV *csv = CALLREG_INTUIT_STRING(aTHX_ rx);
+ char c;
+
+ len = rx->minlen;
+ if (len == 1 && !tail) {
+ c = *SvPV(csv,len);
while (--limit) {
/*SUPPRESS 530*/
- for (m = s; m < strend && *m != i; m++) ;
+ for (m = s; m < strend && *m != c; m++) ;
if (m >= strend)
break;
dstr = NEWSV(30, m-s);
else {
#ifndef lint
while (s < strend && --limit &&
- (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
- rx->check_substr, 0)) )
+ (m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
+ csv, PL_multiline ? FBMrf_MULTILINE : 0)) )
#endif
{
dstr = NEWSV(31, m-s);
if (make_mortal)
sv_2mortal(dstr);
XPUSHs(dstr);
- s = m + i;
+ s = m + len; /* Fake \n at the end */
}
}
}
else {
maxiters += (strend - s) * rx->nparens;
- while (s < strend && --limit &&
- CALLREGEXEC(rx, s, strend, orig, 1, sv, NULL, 0))
+ while (s < strend && --limit
+/* && (!rx->check_substr
+ || ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend,
+ 0, NULL))))
+*/ && CALLREGEXEC(aTHX_ rx, s, strend, orig,
+ 1 /* minend */, sv, NULL, 0))
{
TAINT_IF(RX_MATCH_TAINTED(rx));
- if (rx->subbase
- && rx->subbase != orig) {
+ if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
m = s;
s = orig;
- orig = rx->subbase;
+ orig = rx->subbeg;
s = orig + (m - s);
strend = s + (strend - m);
}
- m = rx->startp[0];
+ m = rx->startp[0] + orig;
dstr = NEWSV(32, m-s);
sv_setpvn(dstr, s, m-s);
if (make_mortal)
XPUSHs(dstr);
if (rx->nparens) {
for (i = 1; i <= rx->nparens; i++) {
- s = rx->startp[i];
- m = rx->endp[i];
+ s = rx->startp[i] + orig;
+ m = rx->endp[i] + orig;
if (m && s) {
dstr = NEWSV(33, m-s);
sv_setpvn(dstr, s, m-s);
XPUSHs(dstr);
}
}
- s = rx->endp[0];
+ s = rx->endp[0] + orig;
}
}
LEAVE_SCOPE(oldsave);
iters = (SP - PL_stack_base) - base;
if (iters > maxiters)
- DIE("Split loop");
+ DIE(aTHX_ "Split loop");
/* keep field after final delim? */
if (s < strend || (iters && origlimit)) {
else {
PUTBACK;
ENTER;
- perl_call_method("PUSH",G_SCALAR|G_DISCARD);
+ call_method("PUSH",G_SCALAR|G_DISCARD);
LEAVE;
SPAGAIN;
if (gimme == G_ARRAY) {
#ifdef USE_THREADS
void
-unlock_condpair(void *svv)
+Perl_unlock_condpair(pTHX_ void *svv)
{
dTHR;
MAGIC *mg = mg_find((SV*)svv, 'm');
if (!mg)
- croak("panic: unlock_condpair unlocking non-mutex");
+ Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex");
MUTEX_LOCK(MgMUTEXP(mg));
if (MgOWNER(mg) != thr)
- croak("panic: unlock_condpair unlocking mutex that we don't own");
+ Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own");
MgOWNER(mg) = 0;
COND_SIGNAL(MgOWNERCONDP(mg));
- DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
- (unsigned long)thr, (unsigned long)svv);)
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n",
+ PTR2UV(thr), PTR2UV(svv));)
MUTEX_UNLOCK(MgMUTEXP(mg));
}
#endif /* USE_THREADS */
while (MgOWNER(mg))
COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
MgOWNER(mg) = thr;
- DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
- (unsigned long)thr, (unsigned long)sv);)
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n",
+ PTR2UV(thr), PTR2UV(sv));)
MUTEX_UNLOCK(MgMUTEXP(mg));
- save_destructor(unlock_condpair, sv);
+ SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
}
#endif /* USE_THREADS */
if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
PUSHs(THREADSV(PL_op->op_targ));
RETURN;
#else
- DIE("tried to access per-thread data in non-threaded perl");
+ DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
#endif /* USE_THREADS */
}
projects / p5sagit/p5-mst-13.2.git / blobdiff