X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/33c2748902d07b7ec367f87ad66e61e89f2aa994..db618c41a27cbc531951f800a5fa5878ef822de0:/doop.c?ds=sidebyside diff --git a/doop.c b/doop.c index c988bff..ad626ca 100644 --- a/doop.c +++ b/doop.c @@ -1,6 +1,6 @@ /* doop.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, 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. @@ -12,27 +12,15 @@ */ #include "EXTERN.h" +#define PERL_IN_DOOP_C #include "perl.h" #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include #endif -#ifndef PERL_OBJECT -static I32 do_trans_CC_simple _((SV *sv)); -static I32 do_trans_CC_count _((SV *sv)); -static I32 do_trans_CC_complex _((SV *sv)); -static I32 do_trans_UU_simple _((SV *sv)); -static I32 do_trans_UU_count _((SV *sv)); -static I32 do_trans_UU_complex _((SV *sv)); -static I32 do_trans_UC_simple _((SV *sv)); -static I32 do_trans_CU_simple _((SV *sv)); -static I32 do_trans_UC_trivial _((SV *sv)); -static I32 do_trans_CU_trivial _((SV *sv)); -#endif - STATIC I32 -do_trans_CC_simple(SV *sv) +S_do_trans_CC_simple(pTHX_ SV *sv) { dTHR; U8 *s; @@ -44,7 +32,7 @@ do_trans_CC_simple(SV *sv) tbl = (short*)cPVOP->op_pv; if (!tbl) - croak("panic: do_trans"); + Perl_croak(aTHX_ "panic: do_trans"); s = (U8*)SvPV(sv, len); send = s + len; @@ -62,7 +50,7 @@ do_trans_CC_simple(SV *sv) } STATIC I32 -do_trans_CC_count(SV *sv) +S_do_trans_CC_count(pTHX_ SV *sv) { dTHR; U8 *s; @@ -73,7 +61,7 @@ do_trans_CC_count(SV *sv) tbl = (short*)cPVOP->op_pv; if (!tbl) - croak("panic: do_trans"); + Perl_croak(aTHX_ "panic: do_trans"); s = (U8*)SvPV(sv, len); send = s + len; @@ -88,7 +76,7 @@ do_trans_CC_count(SV *sv) } STATIC I32 -do_trans_CC_complex(SV *sv) +S_do_trans_CC_complex(pTHX_ SV *sv) { dTHR; U8 *s; @@ -101,7 +89,7 @@ do_trans_CC_complex(SV *sv) tbl = (short*)cPVOP->op_pv; if (!tbl) - croak("panic: do_trans"); + Perl_croak(aTHX_ "panic: do_trans"); s = (U8*)SvPV(sv, len); send = s + len; @@ -145,7 +133,7 @@ do_trans_CC_complex(SV *sv) } STATIC I32 -do_trans_UU_simple(SV *sv) +S_do_trans_UU_simple(pTHX_ SV *sv) { dTHR; U8 *s; @@ -197,7 +185,7 @@ do_trans_UU_simple(SV *sv) } STATIC I32 -do_trans_UU_count(SV *sv) +S_do_trans_UU_count(pTHX_ SV *sv) { dTHR; U8 *s; @@ -224,7 +212,7 @@ do_trans_UU_count(SV *sv) } STATIC I32 -do_trans_UC_simple(SV *sv) +S_do_trans_UC_simple(pTHX_ SV *sv) { dTHR; U8 *s; @@ -277,7 +265,7 @@ do_trans_UC_simple(SV *sv) } STATIC I32 -do_trans_CU_simple(SV *sv) +S_do_trans_CU_simple(pTHX_ SV *sv) { dTHR; U8 *s; @@ -340,7 +328,7 @@ do_trans_CU_simple(SV *sv) /* utf-8 to latin-1 */ STATIC I32 -do_trans_UC_trivial(SV *sv) +S_do_trans_UC_trivial(pTHX_ SV *sv) { dTHR; U8 *s; @@ -372,7 +360,7 @@ do_trans_UC_trivial(SV *sv) /* latin-1 to utf-8 */ STATIC I32 -do_trans_CU_trivial(SV *sv) +S_do_trans_CU_trivial(pTHX_ SV *sv) { dTHR; U8 *s; @@ -406,7 +394,7 @@ do_trans_CU_trivial(SV *sv) } STATIC I32 -do_trans_UU_complex(SV *sv) +S_do_trans_UU_complex(pTHX_ SV *sv) { dTHR; U8 *s; @@ -591,13 +579,13 @@ do_trans_UU_complex(SV *sv) } I32 -do_trans(SV *sv) +Perl_do_trans(pTHX_ SV *sv) { dTHR; STRLEN len; if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL)) - croak(no_modify); + Perl_croak(aTHX_ PL_no_modify); (void)SvPV(sv, len); if (!len) @@ -606,7 +594,7 @@ do_trans(SV *sv) (void)SvPV_force(sv, len); (void)SvPOK_only(sv); - DEBUG_t( deb("2.TBL\n")); + DEBUG_t( Perl_deb(aTHX_ "2.TBL\n")); switch (PL_op->op_private & 63) { case 0: @@ -642,7 +630,7 @@ do_trans(SV *sv) } void -do_join(register SV *sv, SV *del, register SV **mark, register SV **sp) +Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **sp) { SV **oldmark = mark; register I32 items = sp - mark; @@ -653,8 +641,7 @@ do_join(register SV *sv, SV *del, register SV **mark, register SV **sp) mark++; len = (items > 0 ? (delimlen * (items - 1) ) : 0); - if (SvTYPE(sv) < SVt_PV) - sv_upgrade(sv, SVt_PV); + (void)SvUPGRADE(sv, SVt_PV); if (SvLEN(sv) < len + items) { /* current length is way too short */ while (items-- > 0) { if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) { @@ -666,7 +653,7 @@ do_join(register SV *sv, SV *del, register SV **mark, register SV **sp) SvGROW(sv, len + 1); /* so try to pre-extend */ mark = oldmark; - items = sp - mark;; + items = sp - mark; ++mark; } @@ -698,7 +685,7 @@ do_join(register SV *sv, SV *del, register SV **mark, register SV **sp) } void -do_sprintf(SV *sv, I32 len, SV **sarg) +Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg) { STRLEN patlen; char *pat = SvPV(*sarg, patlen); @@ -711,7 +698,7 @@ do_sprintf(SV *sv, I32 len, SV **sarg) } void -do_vecset(SV *sv) +Perl_do_vecset(pTHX_ SV *sv) { SV *targ = LvTARG(sv); register I32 offset; @@ -759,10 +746,11 @@ do_vecset(SV *sv) s[offset+3] = lval & 255; } } + SvSETMAGIC(targ); } void -do_chop(register SV *astr, register SV *sv) +Perl_do_chop(pTHX_ register SV *astr, register SV *sv) { STRLEN len; char *s; @@ -780,7 +768,7 @@ do_chop(register SV *astr, register SV *sv) } return; } - if (SvTYPE(sv) == SVt_PVHV) { + else if (SvTYPE(sv) == SVt_PVHV) { HV* hv = (HV*)sv; HE* entry; (void)hv_iterinit(hv); @@ -789,6 +777,8 @@ do_chop(register SV *astr, register SV *sv) do_chop(astr,hv_iterval(hv,entry)); return; } + else if (SvREADONLY(sv)) + Perl_croak(aTHX_ PL_no_modify); s = SvPV(sv, len); if (len && !SvPOK(sv)) s = SvPV_force(sv, len); @@ -799,8 +789,8 @@ do_chop(register SV *astr, register SV *sv) s = send - 1; while ((*s & 0xc0) == 0x80) --s; - if (UTF8SKIP(s) != send - s) - warn("Malformed UTF-8 character"); + if (UTF8SKIP(s) != send - s && ckWARN_d(WARN_UTF8)) + Perl_warner(aTHX_ WARN_UTF8, "Malformed UTF-8 character"); sv_setpvn(astr, s, send - s); *s = '\0'; SvCUR_set(sv, s - start); @@ -823,7 +813,7 @@ do_chop(register SV *astr, register SV *sv) } I32 -do_chomp(register SV *sv) +Perl_do_chomp(pTHX_ register SV *sv) { dTHR; register I32 count; @@ -832,6 +822,8 @@ do_chomp(register SV *sv) if (RsSNARF(PL_rs)) return 0; + if (RsRECORD(PL_rs)) + return 0; count = 0; if (SvTYPE(sv) == SVt_PVAV) { register I32 i; @@ -845,7 +837,7 @@ do_chomp(register SV *sv) } return count; } - if (SvTYPE(sv) == SVt_PVHV) { + else if (SvTYPE(sv) == SVt_PVHV) { HV* hv = (HV*)sv; HE* entry; (void)hv_iterinit(hv); @@ -854,6 +846,8 @@ do_chomp(register SV *sv) count += do_chomp(hv_iterval(hv,entry)); return count; } + else if (SvREADONLY(sv)) + Perl_croak(aTHX_ PL_no_modify); s = SvPV(sv, len); if (len && !SvPOKp(sv)) s = SvPV_force(sv, len); @@ -897,7 +891,7 @@ do_chomp(register SV *sv) } void -do_vop(I32 optype, SV *sv, SV *left, SV *right) +Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) { dTHR; /* just for taint */ #ifdef LIBERAL @@ -922,7 +916,8 @@ do_vop(I32 optype, SV *sv, SV *left, SV *right) len = leftlen < rightlen ? leftlen : rightlen; lensave = len; if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { - dc = SvPV_force(sv, PL_na); + STRLEN n_a; + dc = SvPV_force(sv, n_a); if (SvCUR(sv) < len) { dc = SvGROW(sv, len + 1); (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); @@ -1011,7 +1006,7 @@ do_vop(I32 optype, SV *sv, SV *left, SV *right) } OP * -do_kv(ARGSproto) +Perl_do_kv(pTHX) { djSP; HV *hv = (HV*)POPs; @@ -1083,7 +1078,7 @@ do_kv(ARGSproto) PUTBACK; tmpstr = realhv ? hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry); - DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu", + DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu", (unsigned long)HeHASH(entry), HvMAX(keys)+1, (unsigned long)(HeHASH(entry) & HvMAX(keys))));