LOGONLY mark 210816 .. 98ccfb as NODOC since they're spell check fixes

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

diff --git a/pp_sys.c b/pp_sys.c
index f9112ff..a6d356e 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -552,38 +552,53 @@ PP(pp_open)
     RETURN;
 }
 
+/* These are private to this function, which is private to this file.
+   Use 0x04 rather than the next available bit, to help the compiler if the
+   architecture can generate more efficient instructions.  */
+#define MORTALIZE_NOT_NEEDED   0x04
+#define TIED_HANDLE_ARGC_SHIFT 3
+
 static OP *
 S_tied_handle_method(pTHX_ const char *const methname, SV **sp,
-                    IO *const io, MAGIC *const mg, const U32 gimme,
-                    unsigned int argc, ...)
+                    IO *const io, MAGIC *const mg, const U32 flags, ...)
 {
+    U32 argc = flags >> TIED_HANDLE_ARGC_SHIFT;
+
     PERL_ARGS_ASSERT_TIED_HANDLE_METHOD;
 
+    /* Ensure that our flag bits do not overlap.  */
+    assert((MORTALIZE_NOT_NEEDED & G_WANT) == 0);
+    assert((G_WANT >> TIED_HANDLE_ARGC_SHIFT) == 0);
+
     PUSHMARK(sp);
     PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
     if (argc) {
+       const U32 mortalize_not_needed = flags & MORTALIZE_NOT_NEEDED;
        va_list args;
-       va_start(args, argc);
+       va_start(args, flags);
        do {
            SV *const arg = va_arg(args, SV *);
-           PUSHs(arg);
+           if(mortalize_not_needed)
+               PUSHs(arg);
+           else
+               mPUSHs(arg);
        } while (--argc);
        va_end(args);
     }
 
     PUTBACK;
     ENTER_with_name("call_tied_handle_method");
-    call_method(methname, gimme);
+    call_method(methname, flags & G_WANT);
     LEAVE_with_name("call_tied_handle_method");
     return NORMAL;
 }
 
 #define tied_handle_method(a,b,c,d)            \
-    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,0)
+    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR)
 #define tied_handle_method1(a,b,c,d,e) \
-    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,1,e)
+    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR | (1 << TIED_HANDLE_ARGC_SHIFT),e)
 #define tied_handle_method2(a,b,c,d,e,f)       \
-    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,2,e,f)
+    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR | (2 << TIED_HANDLE_ARGC_SHIFT), e,f)
 
 PP(pp_close)
 {
@@ -751,8 +766,11 @@ PP(pp_binmode)
               function, which I don't think that the optimiser will be able to
               figure out. Although, as it's a static function, in theory it
               could.  */
-           return S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg, G_SCALAR,
-                                       discp ? 1 : 0, discp);
+           return S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg,
+                                       G_SCALAR|MORTALIZE_NOT_NEEDED
+                                       | (discp
+                                          ? (1 << TIED_HANDLE_ARGC_SHIFT) : 0),
+                                       discp);
        }
     }
 
@@ -837,8 +855,10 @@ PP(pp_tie)
        call_method(methname, G_SCALAR);
     }
     else {
-       /* Not clear why we don't call call_method here too.
-        * perhaps to get different error message ?
+       /* Can't use call_method here, else this: fileno FOO; tie @a, "FOO"
+        * will attempt to invoke IO::File::TIEARRAY, with (best case) the
+        * wrong error message, and worse case, supreme action at a distance.
+        * (Sorry obfuscation writers. You're not going to be given this one.)
         */
        STRLEN len;
        const char *name = SvPV_nomg_const(*MARK, len);
@@ -1217,7 +1237,7 @@ PP(pp_getc)
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            const U32 gimme = GIMME_V;
-           S_tied_handle_method(aTHX_ "GETC", SP, io, mg, gimme, 0);
+           S_tied_handle_method(aTHX_ "GETC", SP, io, mg, gimme);
            if (gimme == G_SCALAR) {
                SPAGAIN;
                SvSetMagicSV_nosteal(TARG, TOPs);
@@ -2053,8 +2073,7 @@ PP(pp_eof)
        RETPUSHNO;
 
     if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
-       return tied_handle_method1("EOF", SP, io, mg,
-                                  sv_2mortal(newSVuv(which)));
+       return tied_handle_method1("EOF", SP, io, mg, newSVuv(which));
     }
 
     if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) {  /* eof() */
@@ -2128,13 +2147,13 @@ PP(pp_sysseek)
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
 #if LSEEKSIZE > IVSIZE
-           SV *const offset_sv = sv_2mortal(newSVnv((NV) offset));
+           SV *const offset_sv = newSVnv((NV) offset);
 #else
-           SV *const offset_sv = sv_2mortal(newSViv(offset));
+           SV *const offset_sv = newSViv(offset);
 #endif
 
            return tied_handle_method2("SEEK", SP, io, mg, offset_sv,
-                                      sv_2mortal(newSViv(whence)));
+                                      newSViv(whence));
        }
     }