Remove the vestigial my_safe{calloc,malloc,free} macros from sv.c

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 0d8673a..80a70ce 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,37 +551,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, 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, G_SCALAR);
+    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,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,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,2,e,f)
+    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR | (2 << TIED_HANDLE_ARGC_SHIFT), e,f)
 
 PP(pp_close)
 {
@@ -661,7 +676,6 @@ badexit:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_func, "pipe");
-    return NORMAL;
 #endif
 }
 
@@ -751,7 +765,10 @@ PP(pp_binmode)
               figure out. Although, as it's a static function, in theory it
               could.  */
            return S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg,
-                                       discp ? 1 : 0, discp);
+                                       G_SCALAR|MORTALIZE_NOT_NEEDED
+                                       | (discp
+                                          ? (1 << TIED_HANDLE_ARGC_SHIFT) : 0),
+                                       discp);
        }
     }
 
@@ -836,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);
@@ -1024,7 +1043,7 @@ PP(pp_sselect)
            if (SvIsCOW(sv))
                sv_force_normal_flags(sv, 0);
            if (SvREADONLY(sv) && !(SvPOK(sv) && SvCUR(sv) == 0))
-               DIE(aTHX_ "%s", PL_no_modify);
+               Perl_croak_no_modify(aTHX);
        }
        if (!SvPOK(sv)) {
            Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Non-string passed as bitmask");
@@ -1147,7 +1166,6 @@ PP(pp_sselect)
     RETURN;
 #else
     DIE(aTHX_ "select not implemented");
-    return NORMAL;
 #endif
 }
 
@@ -1215,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);
-           PUSHs(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 */
@@ -2056,8 +2070,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() */
@@ -2131,13 +2144,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));
        }
     }
 
@@ -2362,7 +2375,6 @@ PP(pp_flock)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "flock()");
-    return NORMAL;
 #endif
 }
 
@@ -2415,7 +2427,6 @@ PP(pp_socket)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "socket");
-    return NORMAL;
 #endif
 }
 
@@ -2477,7 +2488,6 @@ PP(pp_sockpair)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "socketpair");
-    return NORMAL;
 #endif
 }
 
@@ -2509,7 +2519,6 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "bind");
-    return NORMAL;
 #endif
 }
 
@@ -2540,7 +2549,6 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "connect");
-    return NORMAL;
 #endif
 }
 
@@ -2567,7 +2575,6 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "listen");
-    return NORMAL;
 #endif
 }
 
@@ -2647,7 +2654,6 @@ badexit:
 
 #else
     DIE(aTHX_ PL_no_sock_func, "accept");
-    return NORMAL;
 #endif
 }
 
@@ -2672,7 +2678,6 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "shutdown");
-    return NORMAL;
 #endif
 }
 
@@ -2750,7 +2755,6 @@ nuts2:
 
 #else
     DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
-    return NORMAL;
 #endif
 }
 
@@ -2815,7 +2819,6 @@ nuts2:
 
 #else
     DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
-    return NORMAL;
 #endif
 }
 
@@ -3130,7 +3133,7 @@ PP(pp_ftrread)
 #endif
     }
 
-    result = my_stat();
+    result = my_stat_flags(0);
     SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
@@ -3158,7 +3161,7 @@ PP(pp_ftis)
 
     STACKED_FTEST_CHECK;
 
-    result = my_stat();
+    result = my_stat_flags(0);
     SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
@@ -3230,7 +3233,7 @@ PP(pp_ftrowned)
 
     STACKED_FTEST_CHECK;
 
-    result = my_stat();
+    result = my_stat_flags(0);
     SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
@@ -3300,7 +3303,7 @@ PP(pp_ftlink)
     I32 result;
 
     tryAMAGICftest_MG('l');
-    result = my_lstat();
+    result = my_lstat_flags(0);
     SPAGAIN;
 
     if (result < 0)
@@ -3317,6 +3320,8 @@ PP(pp_fttty)
     int fd;
     GV *gv;
     SV *tmpsv = NULL;
+    char *name = NULL;
+    STRLEN namelen;
 
     tryAMAGICftest_MG('t');
 
@@ -3328,15 +3333,17 @@ PP(pp_fttty)
        gv = MUTABLE_GV(POPs);
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
        gv = MUTABLE_GV(SvRV(POPs));
-    else
-       gv = gv_fetchsv(tmpsv = POPs, 0, SVt_PVIO);
+    else {
+       tmpsv = POPs;
+       name = SvPV_nomg(tmpsv, namelen);
+       gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO);
+    }
 
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
        fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
     else if (tmpsv && SvOK(tmpsv)) {
-       const char *tmps = SvPV_nolen_const(tmpsv);
-       if (isDIGIT(*tmps))
-           fd = atoi(tmps);
+       if (isDIGIT(*name))
+           fd = atoi(name);
        else 
            RETPUSHUNDEF;
     }
@@ -3437,7 +3444,7 @@ PP(pp_fttext)
       really_filename:
        PL_statgv = NULL;
        PL_laststype = OP_STAT;
-       sv_setpv(PL_statname, SvPV_nolen_const(sv));
+       sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
        if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
            if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
                                               '\n'))
@@ -3617,7 +3624,6 @@ PP(pp_chroot)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "chroot");
-    return NORMAL;
 #endif
 }
 
@@ -3692,7 +3698,6 @@ PP(pp_link)
 {
     /* Have neither.  */
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
-    return NORMAL;
 }
 #endif
 
@@ -3907,7 +3912,6 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "opendir");
-    return NORMAL;
 #endif
 }
 
@@ -3915,7 +3919,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 +3997,6 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "telldir");
-    return NORMAL;
 #endif
 }
 
@@ -4020,7 +4022,6 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "seekdir");
-    return NORMAL;
 #endif
 }
 
@@ -4044,7 +4045,6 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "rewinddir");
-    return NORMAL;
 #endif
 }
 
@@ -4077,7 +4077,6 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "closedir");
-    return NORMAL;
 #endif
 }
 
@@ -4124,7 +4123,6 @@ PP(pp_fork)
     RETURN;
 #  else
     DIE(aTHX_ PL_no_func, "fork");
-    return NORMAL;
 #  endif
 #endif
 }
@@ -4154,7 +4152,6 @@ PP(pp_wait)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "wait");
-    return NORMAL;
 #endif
 }
 
@@ -4185,7 +4182,6 @@ PP(pp_waitpid)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "waitpid");
-    return NORMAL;
 #endif
 }
 
@@ -4391,7 +4387,6 @@ PP(pp_getppid)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getppid");
-    return NORMAL;
 #endif
 }
 
@@ -4413,7 +4408,6 @@ PP(pp_getpgrp)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getpgrp()");
-    return NORMAL;
 #endif
 }
 
@@ -4447,7 +4441,6 @@ PP(pp_setpgrp)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "setpgrp()");
-    return NORMAL;
 #endif
 }
 
@@ -4461,7 +4454,6 @@ PP(pp_getpriority)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getpriority()");
-    return NORMAL;
 #endif
 }
 
@@ -4477,7 +4469,6 @@ PP(pp_setpriority)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "setpriority()");
-    return NORMAL;
 #endif
 }
 
@@ -4528,7 +4519,6 @@ PP(pp_tms)
     RETURN;
 #   else
     DIE(aTHX_ "times not implemented");
-    return NORMAL;
 #   endif
 #endif /* HAS_TIMES */
 }
@@ -4645,7 +4635,6 @@ PP(pp_alarm)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "alarm");
-    return NORMAL;
 #endif
 }
 
@@ -4715,7 +4704,6 @@ PP(pp_semget)
     RETURN;
 #else
     DIE(aTHX_ "System V IPC is not implemented on this machine");
-    return NORMAL;
 #endif
 }
 
@@ -4851,7 +4839,6 @@ PP(pp_ghostent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "gethostent");
-    return NORMAL;
 #endif
 }
 
@@ -4925,7 +4912,6 @@ PP(pp_gnetent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getnetent");
-    return NORMAL;
 #endif
 }
 
@@ -4986,7 +4972,6 @@ PP(pp_gprotoent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getprotoent");
-    return NORMAL;
 #endif
 }
 
@@ -5062,7 +5047,6 @@ PP(pp_gservent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getservent");
-    return NORMAL;
 #endif
 }
 
@@ -5074,7 +5058,6 @@ PP(pp_shostent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "sethostent");
-    return NORMAL;
 #endif
 }
 
@@ -5086,7 +5069,6 @@ PP(pp_snetent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setnetent");
-    return NORMAL;
 #endif
 }
 
@@ -5098,7 +5080,6 @@ PP(pp_sprotoent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setprotoent");
-    return NORMAL;
 #endif
 }
 
@@ -5110,7 +5091,6 @@ PP(pp_sservent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setservent");
-    return NORMAL;
 #endif
 }
 
@@ -5123,7 +5103,6 @@ PP(pp_ehostent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endhostent");
-    return NORMAL;
 #endif
 }
 
@@ -5136,7 +5115,6 @@ PP(pp_enetent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endnetent");
-    return NORMAL;
 #endif
 }
 
@@ -5149,7 +5127,6 @@ PP(pp_eprotoent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endprotoent");
-    return NORMAL;
 #endif
 }
 
@@ -5162,7 +5139,6 @@ PP(pp_eservent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endservent");
-    return NORMAL;
 #endif
 }
 
@@ -5396,7 +5372,6 @@ PP(pp_gpwent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
-    return NORMAL;
 #endif
 }
 
@@ -5408,7 +5383,6 @@ PP(pp_spwent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "setpwent");
-    return NORMAL;
 #endif
 }
 
@@ -5420,7 +5394,6 @@ PP(pp_epwent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "endpwent");
-    return NORMAL;
 #endif
 }
 
@@ -5495,7 +5468,6 @@ PP(pp_ggrent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
-    return NORMAL;
 #endif
 }
 
@@ -5507,7 +5479,6 @@ PP(pp_sgrent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "setgrent");
-    return NORMAL;
 #endif
 }
 
@@ -5519,7 +5490,6 @@ PP(pp_egrent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "endgrent");
-    return NORMAL;
 #endif
 }
 
@@ -5535,7 +5505,6 @@ PP(pp_getlogin)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getlogin");
-    return NORMAL;
 #endif
 }
 
@@ -5634,7 +5603,6 @@ PP(pp_syscall)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "syscall");
-    return NORMAL;
 #endif
 }