Return DIE(...) to *return*ing Perl_die(...).

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 44b8cf4..1f1f59c 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -487,8 +487,7 @@ PP(pp_die)
     else {
        exsv = newSVpvs_flags("Died", SVs_TEMP);
     }
-    die_sv(exsv);
-    RETURN;
+    return die_sv(exsv);
 }
 
 /* I/O. */
@@ -552,28 +551,71 @@ 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 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, flags);
+       do {
+           SV *const arg = va_arg(args, SV *);
+           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, 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)
+#define tied_handle_method1(a,b,c,d,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 << TIED_HANDLE_ARGC_SHIFT), e,f)
+
 PP(pp_close)
 {
     dVAR; dSP;
     GV * const gv = (MAXARG == 0) ? PL_defoutgv : MUTABLE_GV(POPs);
 
+    if (MAXARG == 0)
+       EXTEND(SP, 1);
+
     if (gv) {
        IO * const io = GvIO(gv);
        if (io) {
            MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
            if (mg) {
-               PUSHMARK(SP);
-               XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-               PUTBACK;
-               ENTER_with_name("call_CLOSE");
-               call_method("CLOSE", G_SCALAR);
-               LEAVE_with_name("call_CLOSE");
-               SPAGAIN;
-               RETURN;
+               return tied_handle_method("CLOSE", SP, io, mg);
            }
        }
     }
-    EXTEND(SP, 1);
     PUSHs(boolSV(do_close(gv, TRUE)));
     RETURN;
 }
@@ -634,7 +676,6 @@ badexit:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_func, "pipe");
-    return NORMAL;
 #endif
 }
 
@@ -653,14 +694,7 @@ PP(pp_fileno)
     if (gv && (io = GvIO(gv))
        && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
     {
-       PUSHMARK(SP);
-       XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-       PUTBACK;
-       ENTER_with_name("call_FILENO");
-       call_method("FILENO", G_SCALAR);
-       LEAVE_with_name("call_FILENO");
-       SPAGAIN;
-       RETURN;
+       return tied_handle_method("FILENO", SP, io, mg);
     }
 
     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) {
@@ -726,20 +760,18 @@ PP(pp_binmode)
     if (gv && (io = GvIO(gv))) {
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
-           PUSHMARK(SP);
-           XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-           if (discp)
-               XPUSHs(discp);
-           PUTBACK;
-           ENTER_with_name("call_BINMODE");
-           call_method("BINMODE", G_SCALAR);
-           LEAVE_with_name("call_BINMODE");
-           SPAGAIN;
-           RETURN;
+           /* This takes advantage of the implementation of the varargs
+              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|MORTALIZE_NOT_NEEDED
+                                       | (discp
+                                          ? (1 << TIED_HANDLE_ARGC_SHIFT) : 0),
+                                       discp);
        }
     }
 
-    EXTEND(SP, 1);
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) {
        if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
            report_evil_fh(gv, io, PL_op->op_type);
@@ -821,8 +853,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);
@@ -878,7 +912,7 @@ PP(pp_untie)
            CV *cv;
            if (gv && isGV(gv) && (cv = GvCV(gv))) {
               PUSHMARK(SP);
-              XPUSHs(SvTIED_obj(MUTABLE_SV(gv), mg));
+              PUSHs(SvTIED_obj(MUTABLE_SV(gv), mg));
               mXPUSHi(SvREFCNT(obj) - 1);
               PUTBACK;
               ENTER_with_name("call_UNTIE");
@@ -1132,7 +1166,6 @@ PP(pp_sselect)
     RETURN;
 #else
     DIE(aTHX_ "select not implemented");
-    return NORMAL;
 #endif
 }
 
@@ -1200,17 +1233,13 @@ PP(pp_getc)
     if (gv && (io = GvIO(gv))) {
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
-           const I32 gimme = GIMME_V;
-           PUSHMARK(SP);
-           XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-           PUTBACK;
-           ENTER;
-           call_method("GETC", gimme);
-           LEAVE;
-           SPAGAIN;
-           if (gimme == G_SCALAR)
+           const U32 gimme = GIMME_V;
+           S_tied_handle_method(aTHX_ "GETC", SP, io, mg, gimme);
+           if (gimme == G_SCALAR) {
+               SPAGAIN;
                SvSetMagicSV_nosteal(TARG, TOPs);
-           RETURN;
+           }
+           return NORMAL;
        }
     }
     if (!gv || do_eof(gv)) { /* make sure we have fp with something */
@@ -1268,14 +1297,15 @@ PP(pp_enterwrite)
     CV *cv = NULL;
     SV *tmpsv = NULL;
 
-    if (MAXARG == 0)
+    if (MAXARG == 0) {
        gv = PL_defoutgv;
+       EXTEND(SP, 1);
+    }
     else {
        gv = MUTABLE_GV(POPs);
        if (!gv)
            gv = PL_defoutgv;
     }
-    EXTEND(SP, 1);
     io = GvIO(gv);
     if (!io) {
        RETPUSHNO;
@@ -2007,43 +2037,40 @@ PP(pp_eof)
     GV *gv;
     IO *io;
     MAGIC *mg;
+    /*
+     * in Perl 5.12 and later, the additional parameter is a bitmask:
+     * 0 = eof
+     * 1 = eof(FH)
+     * 2 = eof()  <- ARGV magic
+     *
+     * I'll rely on the compiler's trace flow analysis to decide whether to
+     * actually assign this out here, or punt it into the only block where it is
+     * used. Doing it out here is DRY on the condition logic.
+     */
+    unsigned int which;
 
-    if (MAXARG)
+    if (MAXARG) {
        gv = PL_last_in_gv = MUTABLE_GV(POPs);  /* eof(FH) */
+       which = 1;
+    }
     else {
        EXTEND(SP, 1);
 
-       if (PL_op->op_flags & OPf_SPECIAL)
+       if (PL_op->op_flags & OPf_SPECIAL) {
            gv = PL_last_in_gv = GvEGVx(PL_argvgv);     /* eof() - ARGV magic */
-       else
+           which = 2;
+       }
+       else {
            gv = PL_last_in_gv;                 /* eof */
+           which = 0;
+       }
     }
 
     if (!gv)
        RETPUSHNO;
 
     if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
-       PUSHMARK(SP);
-       XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-       /*
-        * in Perl 5.12 and later, the additional paramter is a bitmask:
-        * 0 = eof
-        * 1 = eof(FH)
-        * 2 = eof()  <- ARGV magic
-        */
-       EXTEND(SP, 1);
-       if (MAXARG)
-           mPUSHi(1);          /* 1 = eof(FH) - simple, explicit FH */
-       else if (PL_op->op_flags & OPf_SPECIAL)
-           mPUSHi(2);          /* 2 = eof()   - ARGV magic */
-       else
-           mPUSHi(0);          /* 0 = eof     - simple, implicit FH */
-       PUTBACK;
-       ENTER;
-       call_method("EOF", G_SCALAR);
-       LEAVE;
-       SPAGAIN;
-       RETURN;
+       return tied_handle_method1("EOF", SP, io, mg, newSVuv(which));
     }
 
     if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) {  /* eof() */
@@ -2082,14 +2109,7 @@ PP(pp_tell)
     if (gv && (io = GvIO(gv))) {
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
-           PUSHMARK(SP);
-           XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-           PUTBACK;
-           ENTER;
-           call_method("TELL", G_SCALAR);
-           LEAVE;
-           SPAGAIN;
-           RETURN;
+           return tied_handle_method("TELL", SP, io, mg);
        }
     }
     else if (!gv) {
@@ -2123,20 +2143,14 @@ PP(pp_sysseek)
     if (gv && (io = GvIO(gv))) {
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
-           PUSHMARK(SP);
-           XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
 #if LSEEKSIZE > IVSIZE
-           mXPUSHn((NV) offset);
+           SV *const offset_sv = newSVnv((NV) offset);
 #else
-           mXPUSHi(offset);
+           SV *const offset_sv = newSViv(offset);
 #endif
-           mXPUSHi(whence);
-           PUTBACK;
-           ENTER;
-           call_method("SEEK", G_SCALAR);
-           LEAVE;
-           SPAGAIN;
-           RETURN;
+
+           return tied_handle_method2("SEEK", SP, io, mg, offset_sv,
+                                      newSViv(whence));
        }
     }
 
@@ -2361,7 +2375,6 @@ PP(pp_flock)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "flock()");
-    return NORMAL;
 #endif
 }
 
@@ -2414,7 +2427,6 @@ PP(pp_socket)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "socket");
-    return NORMAL;
 #endif
 }
 
@@ -2476,7 +2488,6 @@ PP(pp_sockpair)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "socketpair");
-    return NORMAL;
 #endif
 }
 
@@ -2508,7 +2519,6 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "bind");
-    return NORMAL;
 #endif
 }
 
@@ -2539,7 +2549,6 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "connect");
-    return NORMAL;
 #endif
 }
 
@@ -2566,7 +2575,6 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "listen");
-    return NORMAL;
 #endif
 }
 
@@ -2646,7 +2654,6 @@ badexit:
 
 #else
     DIE(aTHX_ PL_no_sock_func, "accept");
-    return NORMAL;
 #endif
 }
 
@@ -2671,7 +2678,6 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "shutdown");
-    return NORMAL;
 #endif
 }
 
@@ -2749,7 +2755,6 @@ nuts2:
 
 #else
     DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
-    return NORMAL;
 #endif
 }
 
@@ -2814,7 +2819,6 @@ nuts2:
 
 #else
     DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
-    return NORMAL;
 #endif
 }
 
@@ -3616,7 +3620,6 @@ PP(pp_chroot)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "chroot");
-    return NORMAL;
 #endif
 }
 
@@ -3691,7 +3694,6 @@ PP(pp_link)
 {
     /* Have neither.  */
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
-    return NORMAL;
 }
 #endif
 
@@ -3710,7 +3712,6 @@ PP(pp_readlink)
 #endif
     tmps = POPpconstx;
     len = readlink(tmps, buf, sizeof(buf) - 1);
-    EXTEND(SP, 1);
     if (len < 0)
        RETPUSHUNDEF;
     PUSHp(buf, len);
@@ -3907,7 +3908,6 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "opendir");
-    return NORMAL;
 #endif
 }
 
@@ -3915,7 +3915,6 @@ PP(pp_readdir)
 {
 #if !defined(Direntry_t) || !defined(HAS_READDIR)
     DIE(aTHX_ PL_no_dir_func, "readdir");
-    return NORMAL;
 #else
 #if !defined(I_DIRENT) && !defined(VMS)
     Direntry_t *readdir (DIR *);
@@ -3994,7 +3993,6 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "telldir");
-    return NORMAL;
 #endif
 }
 
@@ -4020,7 +4018,6 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "seekdir");
-    return NORMAL;
 #endif
 }
 
@@ -4044,7 +4041,6 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "rewinddir");
-    return NORMAL;
 #endif
 }
 
@@ -4077,7 +4073,6 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "closedir");
-    return NORMAL;
 #endif
 }
 
@@ -4124,7 +4119,6 @@ PP(pp_fork)
     RETURN;
 #  else
     DIE(aTHX_ PL_no_func, "fork");
-    return NORMAL;
 #  endif
 #endif
 }
@@ -4154,7 +4148,6 @@ PP(pp_wait)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "wait");
-    return NORMAL;
 #endif
 }
 
@@ -4185,7 +4178,6 @@ PP(pp_waitpid)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "waitpid");
-    return NORMAL;
 #endif
 }
 
@@ -4391,7 +4383,6 @@ PP(pp_getppid)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getppid");
-    return NORMAL;
 #endif
 }
 
@@ -4413,7 +4404,6 @@ PP(pp_getpgrp)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getpgrp()");
-    return NORMAL;
 #endif
 }
 
@@ -4447,7 +4437,6 @@ PP(pp_setpgrp)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "setpgrp()");
-    return NORMAL;
 #endif
 }
 
@@ -4461,7 +4450,6 @@ PP(pp_getpriority)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getpriority()");
-    return NORMAL;
 #endif
 }
 
@@ -4477,7 +4465,6 @@ PP(pp_setpriority)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "setpriority()");
-    return NORMAL;
 #endif
 }
 
@@ -4528,7 +4515,6 @@ PP(pp_tms)
     RETURN;
 #   else
     DIE(aTHX_ "times not implemented");
-    return NORMAL;
 #   endif
 #endif /* HAS_TIMES */
 }
@@ -4639,14 +4625,12 @@ PP(pp_alarm)
     int anum;
     anum = POPi;
     anum = alarm((unsigned int)anum);
-    EXTEND(SP, 1);
     if (anum < 0)
        RETPUSHUNDEF;
     PUSHi(anum);
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "alarm");
-    return NORMAL;
 #endif
 }
 
@@ -4716,7 +4700,6 @@ PP(pp_semget)
     RETURN;
 #else
     DIE(aTHX_ "System V IPC is not implemented on this machine");
-    return NORMAL;
 #endif
 }
 
@@ -4852,7 +4835,6 @@ PP(pp_ghostent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "gethostent");
-    return NORMAL;
 #endif
 }
 
@@ -4926,7 +4908,6 @@ PP(pp_gnetent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getnetent");
-    return NORMAL;
 #endif
 }
 
@@ -4987,7 +4968,6 @@ PP(pp_gprotoent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getprotoent");
-    return NORMAL;
 #endif
 }
 
@@ -5063,7 +5043,6 @@ PP(pp_gservent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getservent");
-    return NORMAL;
 #endif
 }
 
@@ -5075,7 +5054,6 @@ PP(pp_shostent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "sethostent");
-    return NORMAL;
 #endif
 }
 
@@ -5087,7 +5065,6 @@ PP(pp_snetent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setnetent");
-    return NORMAL;
 #endif
 }
 
@@ -5099,7 +5076,6 @@ PP(pp_sprotoent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setprotoent");
-    return NORMAL;
 #endif
 }
 
@@ -5111,7 +5087,6 @@ PP(pp_sservent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setservent");
-    return NORMAL;
 #endif
 }
 
@@ -5124,7 +5099,6 @@ PP(pp_ehostent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endhostent");
-    return NORMAL;
 #endif
 }
 
@@ -5137,7 +5111,6 @@ PP(pp_enetent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endnetent");
-    return NORMAL;
 #endif
 }
 
@@ -5150,7 +5123,6 @@ PP(pp_eprotoent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endprotoent");
-    return NORMAL;
 #endif
 }
 
@@ -5163,7 +5135,6 @@ PP(pp_eservent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endservent");
-    return NORMAL;
 #endif
 }
 
@@ -5397,7 +5368,6 @@ PP(pp_gpwent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
-    return NORMAL;
 #endif
 }
 
@@ -5409,7 +5379,6 @@ PP(pp_spwent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "setpwent");
-    return NORMAL;
 #endif
 }
 
@@ -5421,7 +5390,6 @@ PP(pp_epwent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "endpwent");
-    return NORMAL;
 #endif
 }
 
@@ -5496,7 +5464,6 @@ PP(pp_ggrent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
-    return NORMAL;
 #endif
 }
 
@@ -5508,7 +5475,6 @@ PP(pp_sgrent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "setgrent");
-    return NORMAL;
 #endif
 }
 
@@ -5520,7 +5486,6 @@ PP(pp_egrent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "endgrent");
-    return NORMAL;
 #endif
 }
 
@@ -5536,7 +5501,6 @@ PP(pp_getlogin)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getlogin");
-    return NORMAL;
 #endif
 }
 
@@ -5635,7 +5599,6 @@ PP(pp_syscall)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "syscall");
-    return NORMAL;
 #endif
 }