Long double patches from Dan Sugalski.

[perl5.git] / doop.c

diff --git a/doop.c b/doop.c
index ccabba1..ad626ca 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -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 <signal.h>
 #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(PL_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;
@@ -665,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;
     }
 
@@ -697,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);
@@ -710,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;
@@ -758,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;
@@ -779,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);
@@ -788,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);
@@ -798,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);
@@ -822,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;
@@ -846,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);
@@ -855,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);
@@ -898,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
@@ -1013,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;
@@ -1085,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))));