support bytecode and C backends in perlcc (patch suggested

[p5sagit/p5-mst-13.2.git] / pp.c

diff --git a/pp.c b/pp.c
index 3cc9759..4d96370 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -375,6 +375,8 @@ PP(pp_rv2cv)
     if (cv) {
        if (CvCLONE(cv))
            cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+       if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv))
+           Perl_croak(aTHX_ "Can't modify non-lvalue subroutine call");
     }
     else
        cv = (CV*)&PL_sv_undef;
@@ -900,7 +902,6 @@ PP(pp_pow)
 PP(pp_multiply)
 {
     djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
-    tryIVIVbin(*);
     {
       dPOPTOPnnrl;
       SETn( left * right );
@@ -911,16 +912,6 @@ PP(pp_multiply)
 PP(pp_divide)
 {
     djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
-    if (TOPIOKbin) {
-      dPOPTOPiirl_ul;
-      if (right == 0)
-       DIE(aTHX_ "Illegal division by zero");
-      if ((left % right) && !(PL_op->op_private & HINT_INTEGER))
-       SETn( (NV)left / (NV)right );
-      else
-       SETi( left / right );
-      RETURN;
-    }
     {
       dPOPPOPnnrl;
       NV value;
@@ -1100,7 +1091,6 @@ PP(pp_repeat)
 PP(pp_subtract)
 {
     djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
-    tryIVIVbin(-);
     {
       dPOPTOPnnrl_ul;
       SETn( left - right );
@@ -1113,14 +1103,10 @@ PP(pp_left_shift)
     djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
     {
       IV shift = POPi;
-      if (PL_op->op_private & HINT_INTEGER) {
-       IV i = TOPi;
-       SETi(i << shift);
-      }
-      else {
-       UV u = TOPu;
-       SETu(u << shift);
-      }
+      if (PL_op->op_private & HINT_INTEGER)
+       SETi(TOPi << shift);
+      else
+       SETu(TOPu << shift);
       RETURN;
     }
 }
@@ -1130,14 +1116,10 @@ PP(pp_right_shift)
     djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
     {
       IV shift = POPi;
-      if (PL_op->op_private & HINT_INTEGER) {
-       IV i = TOPi;
-       SETi(i >> shift);
-      }
-      else {
-       UV u = TOPu;
-       SETu(u >> shift);
-      }
+      if (PL_op->op_private & HINT_INTEGER)
+       SETi(TOPi >> shift);
+      else
+       SETu(TOPu >> shift);
       RETURN;
     }
 }
@@ -1305,14 +1287,10 @@ PP(pp_bit_and)
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-       if (PL_op->op_private & HINT_INTEGER) {
-         IV value = SvIV(left) & SvIV(right);
-         SETi(value);
-       }
-       else {
-         UV value = SvUV(left) & SvUV(right);
-         SETu(value);
-       }
+       if (PL_op->op_private & HINT_INTEGER)
+         SETi( SvIV(left) & SvIV(right) );
+       else
+         SETu( SvUV(left) & SvUV(right) );
       }
       else {
        do_vop(PL_op->op_type, TARG, left, right);
@@ -1328,14 +1306,10 @@ PP(pp_bit_xor)
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-       if (PL_op->op_private & HINT_INTEGER) {
-         IV value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
-         SETi(value);
-       }
-       else {
-         UV value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
-         SETu(value);
-       }
+       if (PL_op->op_private & HINT_INTEGER)
+         SETi( (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right) );
+       else
+         SETu( (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right) );
       }
       else {
        do_vop(PL_op->op_type, TARG, left, right);
@@ -1351,14 +1325,10 @@ PP(pp_bit_or)
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-       if (PL_op->op_private & HINT_INTEGER) {
-         IV value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
-         SETi(value);
-       }
-       else {
-         UV value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
-         SETu(value);
-       }
+       if (PL_op->op_private & HINT_INTEGER)
+         SETi( (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right) );
+       else
+         SETu( (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right) );
       }
       else {
        do_vop(PL_op->op_type, TARG, left, right);
@@ -1417,14 +1387,10 @@ PP(pp_complement)
     {
       dTOPss;
       if (SvNIOKp(sv)) {
-       if (PL_op->op_private & HINT_INTEGER) {
-         IV value = ~SvIV(sv);
-         SETi(value);
-       }
-       else {
-         UV value = ~SvUV(sv);
-         SETu(value);
-       }
+       if (PL_op->op_private & HINT_INTEGER)
+         SETi( ~SvIV(sv) );
+       else
+         SETu( ~SvUV(sv) );
       }
       else {
        register char *tmps;
@@ -2029,74 +1995,24 @@ PP(pp_vec)
     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;
 }
@@ -5004,14 +4920,7 @@ PP(pp_split)
                ++s;
        }
     }
-    else if (rx->prelen == 1 && *rx->precomp == '^') {
-       if (!(pm->op_pmflags & PMf_MULTILINE)
-           && !(pm->op_pmregexp->reganch & ROPT_WARNED)) {
-           if (ckWARN(WARN_DEPRECATED))
-               Perl_warner(aTHX_ WARN_DEPRECATED,
-                           "split /^/ better written as split /^/m");
-           pm->op_pmregexp->reganch |= ROPT_WARNED;
-       }       
+    else if (strEQ("^", rx->precomp)) {
        while (--limit) {
            /*SUPPRESS 530*/
            for (m = s; m < strend && *m != '\n'; m++) ;