This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove repeated PL_stack_sp derefs in Perl_eval_sv/Perl_call_sv
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index bfce4ef..bf4d549 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1500,6 +1500,14 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
         }
     }
 #endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */
+
+#ifdef __amigaos4__
+    {
+        struct NameTranslationInfo nti;
+        __translate_amiga_to_unix_path_name(&argv[0],&nti); 
+    }
+#endif
+
     PL_origargc = argc;
     PL_origargv = argv;
 
@@ -1779,6 +1787,9 @@ S_Internals_V(pTHX_ CV *cv)
 #  ifdef USE_LOCALE_CTYPE
                             " USE_LOCALE_CTYPE"
 #  endif
+#  ifdef WIN32_NO_REGISTRY
+                            " USE_NO_REGISTRY"
+#  endif
 #  ifdef USE_PERL_ATOF
                             " USE_PERL_ATOF"
 #  endif              
@@ -2688,7 +2699,7 @@ I32
 Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
                        /* See G_* flags in cop.h */
 {
-    dVAR; dSP;
+    dVAR;
     LOGOP myop;                /* fake syntax tree node */
     METHOP method_op;
     I32 oldmark;
@@ -2718,9 +2729,14 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
     SAVEOP();
     PL_op = (OP*)&myop;
 
-    EXTEND(PL_stack_sp, 1);
-    if (!(flags & G_METHOD_NAMED))
-        *++PL_stack_sp = sv;
+    {
+       dSP;
+       EXTEND(SP, 1);
+       if (!(flags & G_METHOD_NAMED)) {
+           PUSHs(sv);
+           PUTBACK;
+       }
+    }
     oldmark = TOPMARK;
     oldscope = PL_scopestack_ix;
 
@@ -2831,9 +2847,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
                        /* See G_* flags in cop.h */
 {
     dVAR;
-    dSP;
     UNOP myop;         /* fake syntax tree node */
-    VOL I32 oldmark = SP - PL_stack_base;
+    VOL I32 oldmark;
     VOL I32 retval = 0;
     int ret;
     OP* const oldop = PL_op;
@@ -2849,8 +2864,13 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     SAVEOP();
     PL_op = (OP*)&myop;
     Zero(&myop, 1, UNOP);
-    EXTEND(PL_stack_sp, 1);
-    *++PL_stack_sp = sv;
+    {
+       dSP;
+       oldmark = SP - PL_stack_base;
+       EXTEND(SP, 1);
+       PUSHs(sv);
+       PUTBACK;
+    }
 
     if (!(flags & G_NOARGS))
        myop.op_flags = OPf_STACKED;
@@ -3816,14 +3836,6 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
     return rsfp;
 }
 
-/* Mention
- * I_SYSSTATVFS        HAS_FSTATVFS
- * I_SYSMOUNT
- * I_STATFS    HAS_FSTATFS     HAS_GETFSSTAT
- * I_MNTENT    HAS_GETMNTENT   HAS_HASMNTOPT
- * here so that metaconfig picks them up. */
-
-
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 /* Don't even need this function.  */
 #else
@@ -3840,16 +3852,13 @@ S_validate_suid(pTHX_ PerlIO *rsfp)
     if (my_euid != my_uid || my_egid != my_gid) {      /* (suidperl doesn't exist, in fact) */
        dVAR;
         int fd = PerlIO_fileno(rsfp);
-        if (fd < 0) {
-            Perl_croak(aTHX_ "Illegal suidscript");
-        } else {
-            if (PerlLIO_fstat(fd, &PL_statbuf) < 0) {  /* may be either wrapped or real suid */
-                Perl_croak(aTHX_ "Illegal suidscript");
-            }
+        Stat_t statbuf;
+        if (fd < 0 || PerlLIO_fstat(fd, &statbuf) < 0) { /* may be either wrapped or real suid */
+            Perl_croak_nocontext( "Illegal suidscript");
         }
-        if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
+        if ((my_euid != my_uid && my_euid == statbuf.st_uid && statbuf.st_mode & S_ISUID)
             ||
-            (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
+            (my_egid != my_gid && my_egid == statbuf.st_gid && statbuf.st_mode & S_ISGID)
             )
            if (!PL_do_undump)
                Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\