perlopentut: correct perlfaq links

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 2416951..a9ee2d1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -175,19 +175,6 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
      || (CvSTART(PL_compcv) && !CvSLABBED(PL_compcv)))
        return PerlMemShared_calloc(1, sz);
 
-#if defined(USE_ITHREADS) && IVSIZE > U32SIZE && IVSIZE > PTRSIZE
-    /* Work around a goof with alignment on our part. For sparc32 (and
-       possibly other architectures), if built with -Duse64bitint, the IV
-       op_pmoffset in struct pmop should be 8 byte aligned, but the slab
-       allocator is only providing 4 byte alignment. The real fix is to change
-       the IV to a type the same size as a pointer, such as size_t, but we
-       can't do that without breaking the ABI, which is a no-no in a maint
-       release. So instead, simply allocate struct pmop directly, which will be
-       suitably aligned:  */
-    if (sz == sizeof(struct pmop))
-       return PerlMemShared_calloc(1, sz);
-#endif
-
     /* While the subroutine is under construction, the slabs are accessed via
        CvSTART(), to avoid needing to expand PVCV by one pointer for something
        unneeded at runtime. Once a subroutine is constructed, the slabs are
@@ -311,7 +298,7 @@ Perl_Slab_to_rw(pTHX_ OPSLAB *const slab)
 }
 
 #else
-#  define Slab_to_rw(op)
+#  define Slab_to_rw(op)    NOOP
 #endif
 
 /* This cannot possibly be right, but it was copied from the old slab
@@ -741,9 +728,8 @@ Perl_op_free(pTHX_ OP *o)
     if (type == OP_NULL)
        type = (OPCODE)o->op_targ;
 
-    if (o->op_slabbed) {
-       Slab_to_rw(OpSLAB(o));
-    }
+    if (o->op_slabbed)
+        Slab_to_rw(OpSLAB(o));
 
     /* COP* is not cleared by op_clear() so that we may track line
      * numbers etc even after null() */
@@ -1395,29 +1381,16 @@ Perl_scalarvoid(pTHX_ OP *o)
                else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
                    useless = NULL;
                else if (SvPOK(sv)) {
-                  /* perl4's way of mixing documentation and code
-                     (before the invention of POD) was based on a
-                     trick to mix nroff and perl code. The trick was
-                     built upon these three nroff macros being used in
-                     void context. The pink camel has the details in
-                     the script wrapman near page 319. */
-                   const char * const maybe_macro = SvPVX_const(sv);
-                   if (strnEQ(maybe_macro, "di", 2) ||
-                       strnEQ(maybe_macro, "ds", 2) ||
-                       strnEQ(maybe_macro, "ig", 2))
-                           useless = NULL;
-                   else {
-                       SV * const dsv = newSVpvs("");
-                       useless_sv
-                            = Perl_newSVpvf(aTHX_
-                                            "a constant (%s)",
-                                            pv_pretty(dsv, maybe_macro,
-                                                      SvCUR(sv), 32, NULL, NULL,
-                                                      PERL_PV_PRETTY_DUMP
-                                                      | PERL_PV_ESCAPE_NOCLEAR
-                                                      | PERL_PV_ESCAPE_UNI_DETECT));
-                       SvREFCNT_dec_NN(dsv);
-                   }
+                    SV * const dsv = newSVpvs("");
+                    useless_sv
+                        = Perl_newSVpvf(aTHX_
+                                        "a constant (%s)",
+                                        pv_pretty(dsv, SvPVX_const(sv),
+                                                  SvCUR(sv), 32, NULL, NULL,
+                                                  PERL_PV_PRETTY_DUMP
+                                                  | PERL_PV_ESCAPE_NOCLEAR
+                                                  | PERL_PV_ESCAPE_UNI_DETECT));
+                    SvREFCNT_dec_NN(dsv);
                }
                else if (SvOK(sv)) {
                    useless_sv = Perl_newSVpvf(aTHX_ "a constant (%"SVf")", sv);
@@ -3372,7 +3345,10 @@ S_fold_constants(pTHX_ OP *o)
     if (type == OP_RV2GV)
        newop = newGVOP(OP_GV, 0, MUTABLE_GV(sv));
     else
+    {
        newop = newSVOP(OP_CONST, OPpCONST_FOLDED<<8, MUTABLE_SV(sv));
+       newop->op_folded = 1;
+    }
     op_getmad(o,newop,'f');
     return newop;
 
@@ -5907,6 +5883,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
                other->op_flags |= OPf_SPECIAL;
            else if (other->op_type == OP_CONST)
                other->op_private |= OPpCONST_FOLDED;
+
+           other->op_folded = 1;
            return other;
        }
        else {
@@ -6068,6 +6046,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
            live->op_flags |= OPf_SPECIAL;
        else if (live->op_type == OP_CONST)
            live->op_private |= OPpCONST_FOLDED;
+       live->op_folded = 1;
        return live;
     }
     NewOp(1101, logop, 1, LOGOP);
@@ -6816,10 +6795,10 @@ Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p,
 
     PERL_ARGS_ASSERT_CV_CKPROTO_LEN_FLAGS;
 
-    if (!ckWARN_d(WARN_PROTOTYPE))
+    if (p == NULL && cvp == NULL)
        return;
 
-    if (p == NULL && cvp == NULL)
+    if (!ckWARN_d(WARN_PROTOTYPE))
        return;
 
     if (p && cvp) {
@@ -6854,14 +6833,14 @@ Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p,
     if (name)
        Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, SVfARG(name));
     if (cvp)
-       Perl_sv_catpvf(aTHX_ msg, " (%"SVf")",
-           SVfARG(newSVpvn_flags(cvp,clen, SvUTF8(cv)|SVs_TEMP))
+       Perl_sv_catpvf(aTHX_ msg, " (%"UTF8f")", 
+           UTF8fARG(SvUTF8(cv),clen,cvp)
        );
     else
        sv_catpvs(msg, ": none");
     sv_catpvs(msg, " vs ");
     if (p)
-       Perl_sv_catpvf(aTHX_ msg, "(%"SVf")", SVfARG(newSVpvn_flags(p, len, flags | SVs_TEMP)));
+       Perl_sv_catpvf(aTHX_ msg, "(%"UTF8f")", UTF8fARG(flags & SVf_UTF8,len,p));
     else
        sv_catpvs(msg, "none");
     Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, SVfARG(msg));
@@ -8678,7 +8657,7 @@ Perl_ck_ftst(pTHX_ OP *o)
        const OPCODE kidtype = kid->op_type;
 
        if (kidtype == OP_CONST && (kid->op_private & OPpCONST_BARE)
-        && !(kid->op_private & OPpCONST_FOLDED)) {
+        && !kid->op_folded) {
            OP * const newop = newGVOP(type, OPf_REF,
                gv_fetchsv(kid->op_sv, GV_ADD, SVt_PVIO));
 #ifdef PERL_MAD
@@ -9263,7 +9242,7 @@ Perl_ck_listiob(pTHX_ OP *o)
        kid = kid->op_sibling;
     else if (kid && !kid->op_sibling) {                /* print HANDLE; */
        if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE
-        && !(kid->op_private & OPpCONST_FOLDED)) {
+        && !kid->op_folded) {
            o->op_flags |= OPf_STACKED; /* make it a filehandle */
            kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
            cLISTOPo->op_first->op_sibling = kid;
@@ -10630,8 +10609,8 @@ Perl_ck_trunc(pTHX_ OP *o)
        if (kid->op_type == OP_NULL)
            kid = (SVOP*)kid->op_sibling;
        if (kid && kid->op_type == OP_CONST &&
-           (kid->op_private & (OPpCONST_BARE|OPpCONST_FOLDED))
-                            == OPpCONST_BARE)
+           (kid->op_private & OPpCONST_BARE) &&
+           !kid->op_folded)
        {
            o->op_flags |= OPf_SPECIAL;
            kid->op_private &= ~OPpCONST_STRICT;
@@ -11980,14 +11959,7 @@ const_sv_xsub(pTHX_ CV* cv)
     dVAR;
     dXSARGS;
     SV *const sv = MUTABLE_SV(XSANY.any_ptr);
-    if (items != 0) {
-       NOOP;
-#if 0
-       /* diag_listed_as: SKIPME */
-        Perl_croak(aTHX_ "usage: %s::%s()",
-                   HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
-#endif
-    }
+    PERL_UNUSED_ARG(items);
     if (!sv) {
        XSRETURN(0);
     }