[asperl] more changes to satisfy non-debug VC build (C-API doesn't

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

diff --git a/op.c b/op.c
index 1f564de..de4a94c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -18,6 +18,12 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+#ifdef PERL_OBJECT
+#define CHECKCALL this->*check
+#else
+#define CHECKCALL *check
+#endif
+
 /*
  * In the following definition, the ", Nullop" is just to make the compiler
  * think the expression is of the right type: croak actually does a Siglongjmp.
@@ -27,13 +33,14 @@
      ? ( op_free((OP*)o),                                      \
         croak("%s trapped by operation mask", op_desc[type]),  \
         Nullop )                                               \
-     : (*check[type])((OP*)o))
+     : (CHECKCALL[type])((OP*)o))
 
+static bool scalar_mod_type _((OP *o, I32 type));
+#ifndef PERL_OBJECT
 static I32 list_assignment _((OP *o));
 static void bad_type _((I32 n, char *t, char *name, OP *kid));
 static OP *modkids _((OP *o, I32 type));
 static OP *no_fh_allowed _((OP *o));
-static bool scalar_mod_type _((OP *o, I32 type));
 static OP *scalarboolean _((OP *o));
 static OP *too_few_arguments _((OP *o, char* name));
 static OP *too_many_arguments _((OP *o, char* name));
@@ -42,8 +49,9 @@ static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
        CV* startcv, I32 cx_ix));
 static OP *newDEFSVOP _((void));
 static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
+#endif
 
-static char*
+STATIC char*
 gv_ename(GV *gv)
 {
     SV* tmpsv = sv_newmortal();
@@ -51,7 +59,7 @@ gv_ename(GV *gv)
     return SvPV(tmpsv,na);
 }
 
-static OP *
+STATIC OP *
 no_fh_allowed(OP *o)
 {
     yyerror(form("Missing comma after first argument to %s function",
@@ -59,21 +67,21 @@ no_fh_allowed(OP *o)
     return o;
 }
 
-static OP *
+STATIC OP *
 too_few_arguments(OP *o, char *name)
 {
     yyerror(form("Not enough arguments for %s", name));
     return o;
 }
 
-static OP *
+STATIC OP *
 too_many_arguments(OP *o, char *name)
 {
     yyerror(form("Too many arguments for %s", name));
     return o;
 }
 
-static void
+STATIC void
 bad_type(I32 n, char *t, char *name, OP *kid)
 {
     yyerror(form("Type of arg %d to %s must be %s (not %s)",
@@ -157,7 +165,7 @@ pad_allocmy(char *name)
     return off;
 }
 
-static PADOFFSET
+STATIC PADOFFSET
 pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
 {
     dTHR;
@@ -532,6 +540,11 @@ find_threadsv(char *name)
            sawampersand = TRUE;
            SvREADONLY_on(sv);
            /* FALL THROUGH */
+
+       /* XXX %! tied to Errno.pm needs to be added here.
+        * See gv_fetchpv(). */
+       /* case '!': */
+
        default:
            sv_magic(sv, 0, 0, name, 1); 
        }
@@ -574,7 +587,8 @@ op_free(OP *o)
        break;
 #endif /* USE_THREADS */
     default:
-       if (!(o->op_flags & OPf_REF) || (check[o->op_type] != ck_ftst))
+       if (!(o->op_flags & OPf_REF)
+           || (check[o->op_type] != FUNC_NAME_TO_PTR(ck_ftst)))
            break;
        /* FALL THROUGH */
     case OP_GVSV:
@@ -615,7 +629,7 @@ op_free(OP *o)
     Safefree(o);
 }
 
-static void
+STATIC void
 null(OP *o)
 {
     if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
@@ -664,7 +678,7 @@ scalarkids(OP *o)
     return o;
 }
 
-static OP *
+STATIC OP *
 scalarboolean(OP *o)
 {
     if (dowarn &&
@@ -1034,7 +1048,7 @@ scalarseq(OP *o)
     return o;
 }
 
-static OP *
+STATIC OP *
 modkids(OP *o, I32 type)
 {
     OP *kid;
@@ -1535,7 +1549,7 @@ block_end(I32 floor, OP *seq)
     return retval;
 }
 
-static OP *
+STATIC OP *
 newDEFSVOP(void)
 {
 #ifdef USE_THREADS
@@ -1669,7 +1683,7 @@ fold_constants(register OP *o)
     curop = LINKLIST(o);
     o->op_next = 0;
     op = curop;
-    runops();
+    CALLRUNOPS();
     sv = *(stack_sp--);
     if (o->op_targ && sv == PAD_SV(o->op_targ))        /* grab pad temp? */
        pad_swipe(o->op_targ);
@@ -1681,9 +1695,12 @@ fold_constants(register OP *o)
     if (type == OP_RV2GV)
        return newGVOP(OP_GV, 0, (GV*)sv);
     else {
-       if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
+       /* try to smush double to int, but don't smush -2.0 to -2 */
+       if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK &&
+           type != OP_NEGATE)
+       {
            IV iv = SvIV(sv);
-           if ((double)iv == SvNV(sv)) {       /* can we smush double to int */
+           if ((double)iv == SvNV(sv)) {
                SvREFCNT_dec(sv);
                sv = newSViv(iv);
            }
@@ -1731,7 +1748,7 @@ gen_constant_list(register OP *o)
     op = curop = LINKLIST(o);
     o->op_next = 0;
     pp_pushmark(ARGS);
-    runops();
+    CALLRUNOPS();
     op = curop;
     pp_anonlist(ARGS);
     tmps_floor = oldtmps_floor;
@@ -2368,7 +2385,7 @@ newSLICEOP(I32 flags, OP *subscript, OP *listval)
            list(force_list(listval)) );
 }
 
-static I32
+STATIC I32
 list_assignment(register OP *o)
 {
     if (!o)
@@ -2436,7 +2453,6 @@ newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right)
                list(force_list(left)) );
        o->op_private = 0 | (flags >> 8);
        if (!(left->op_private & OPpLVAL_INTRO)) {
-           static int generation = 100;
            OP *curop;
            OP *lastop = o;
            generation++;
@@ -2612,7 +2628,7 @@ newLOGOP(I32 type, I32 flags, OP *first, OP *other)
     return new_logop(type, flags, &first, &other);
 }
 
-static OP *
+STATIC OP *
 new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
 {
     dTHR;
@@ -2669,7 +2685,7 @@ new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
        case OP_NULL:
            if (k2 && k2->op_type == OP_READLINE
                  && (k2->op_flags & OPf_STACKED)
-                 && (k1->op_type == OP_RV2SV || k1->op_type == OP_PADSV))
+                 && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
                warnop = k2->op_type;
            break;
 
@@ -2831,6 +2847,24 @@ newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block)
            || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
            expr = newUNOP(OP_DEFINED, 0,
                newASSIGNOP(0, newDEFSVOP(), 0, expr) );
+       } else if (expr->op_flags & OPf_KIDS) {
+           OP *k1 = ((UNOP*)expr)->op_first;
+           OP *k2 = (k1) ? k1->op_sibling : NULL;
+           switch (expr->op_type) {
+             case OP_NULL: 
+               if (k2 && k2->op_type == OP_READLINE
+                     && (k2->op_flags & OPf_STACKED)
+                     && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
+                   expr = newUNOP(OP_DEFINED, 0, expr);
+               break;                                
+
+             case OP_SASSIGN:
+               if (k1->op_type == OP_READDIR
+                     || k1->op_type == OP_GLOB
+                     || k1->op_type == OP_EACH)
+                   expr = newUNOP(OP_DEFINED, 0, expr);
+               break;
+           }
        }
     }
 
@@ -2866,6 +2900,24 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b
                 || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
        expr = newUNOP(OP_DEFINED, 0,
            newASSIGNOP(0, newDEFSVOP(), 0, expr) );
+    } else if (expr && (expr->op_flags & OPf_KIDS)) {
+       OP *k1 = ((UNOP*)expr)->op_first;
+       OP *k2 = (k1) ? k1->op_sibling : NULL;
+       switch (expr->op_type) {
+         case OP_NULL: 
+           if (k2 && k2->op_type == OP_READLINE
+                 && (k2->op_flags & OPf_STACKED)
+                 && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
+               expr = newUNOP(OP_DEFINED, 0, expr);
+           break;                                
+
+         case OP_SASSIGN:
+           if (k1->op_type == OP_READDIR
+                 || k1->op_type == OP_GLOB
+                 || k1->op_type == OP_EACH)
+               expr = newUNOP(OP_DEFINED, 0, expr);
+           break;
+       }
     }
 
     if (!block)
@@ -3061,7 +3113,7 @@ cv_undef(CV *cv)
 }
 
 #ifdef DEBUG_CLOSURES
-static void
+STATIC void
 cv_dump(cv)
 CV* cv;
 {
@@ -3106,7 +3158,7 @@ CV* cv;
 }
 #endif /* DEBUG_CLOSURES */
 
-static CV *
+STATIC CV *
 cv_clone2(CV *proto, CV *outside)
 {
     dTHR;
@@ -3307,7 +3359,8 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 {
     dTHR;
     char *name = o ? SvPVx(cSVOPo->op_sv, na) : Nullch;
-    GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
+    GV *gv = gv_fetchpv(name ? name : "__ANON__",
+                       GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
     char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch;
     register CV *cv;
     I32 ix;
@@ -3317,6 +3370,23 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
     if (proto)
        SAVEFREEOP(proto);
 
+    if (SvTYPE(gv) != SVt_PVGV) {      /* Prototype now, and had
+                                          maximum a prototype before. */
+       if (SvTYPE(gv) > SVt_NULL) {
+           if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1))
+               warn("Runaway prototype");
+           cv_ckproto((CV*)gv, NULL, ps);
+       }
+       if (ps)
+           sv_setpv((SV*)gv, ps);
+       else
+           sv_setiv((SV*)gv, -1);
+       SvREFCNT_dec(compcv);
+       compcv = NULL;
+       sub_generation++;
+       goto noblock;
+    }
+
     if (!name || GvCVGEN(gv))
        cv = Nullcv;
     else if (cv = GvCV(gv)) {
@@ -3398,6 +3468,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
        }
     }
     if (!block) {
+      noblock:
        copline = NOLINE;
        LEAVE_SCOPE(floor);
        return cv;
@@ -3543,7 +3614,7 @@ newCONSTSUB(HV *stash, char *name, SV *sv)
 }
 
 CV *
-newXS(char *name, void (*subaddr) (CV *), char *filename)
+newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
 {
     dTHR;
     GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);