amigaos4: exec returns I32

Unlike UNIXish fork-exec, in amigaos forking is more like
starting a thread, the return code is more than a boolean.

diff --git a/doio.c b/doio.c
index 6a0d80c..cf76114 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1543,12 +1543,14 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
     }
 }
 
-bool
+DO_EXEC_TYPE
 Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
               int fd, int do_report)
 {
     dVAR;
+    DO_EXEC_TYPE result = DO_EXEC_FAILURE;
     PERL_ARGS_ASSERT_DO_AEXEC5;
+    PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */
 #if defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__)
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
@@ -1571,16 +1573,21 @@ Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
            (really && *tmps != '/'))           /* will execvp use PATH? */
            TAINT_ENV();                /* testing IFS here is overkill, probably */
        PERL_FPU_PRE_EXEC
-       if (really && *tmps)
-           PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
-       else
-           PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+       if (really && *tmps) {
+            result =
+              (DO_EXEC_TYPE)
+              PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
+       } else {
+           result =
+              (DO_EXEC_TYPE)
+              PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+       }
        PERL_FPU_POST_EXEC
        S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report);
     }
     do_execfree();
 #endif
-    return FALSE;
+    return DO_EXEC_RETVAL(result);
 }
 
 void
@@ -1594,7 +1601,7 @@ Perl_do_execfree(pTHX)
 
 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
 
-bool
+DO_EXEC_TYPE
 Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 {
     dVAR;
@@ -1604,6 +1611,8 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     char *cmd;
     /* Make a copy so we can change it */
     const Size_t cmdlen = strlen(incmd) + 1;
+    DO_EXEC_TYPE result = DO_EXEC_FAILURE;
+    PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */
 
     PERL_ARGS_ASSERT_DO_EXEC3;
 
@@ -1639,12 +1648,14 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
              if (s[-1] == '\'') {
                  *--s = '\0';
                  PERL_FPU_PRE_EXEC
-                 PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
+                 result =
+                    (DO_EXEC_TYPE)
+                    PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
                  PERL_FPU_POST_EXEC
                  *s = '\'';
                  S_exec_failed(aTHX_ PL_cshname, fd, do_report);
                  Safefree(buf);
-                 return FALSE;
+                 return DO_EXEC_RETVAL(result);
              }
          }
        }
@@ -1688,11 +1699,25 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
            }
          doshell:
            PERL_FPU_PRE_EXEC
-           PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
+           result =
+              (DO_EXEC_TYPE)
+              PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
            PERL_FPU_POST_EXEC
            S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
+#if defined (__amigaos4__)
+           /* We *must* write something to our pipe or else
+            * the other end hangs */
+           {
+               int e = errno;
+
+               if (do_report) {
+                   PerlLIO_write(fd, (void*)&e, sizeof(int));
+                   PerlLIO_close(fd);
+               }
+           }
+#endif
            Safefree(buf);
-           return FALSE;
+           return DO_EXEC_RETVAL(result);
        }
     }
 
@@ -1712,7 +1737,9 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     *a = NULL;
     if (PL_Argv[0]) {
        PERL_FPU_PRE_EXEC
-       PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+       result =
+          (DO_EXEC_TYPE)
+          PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
        PERL_FPU_POST_EXEC
        if (errno == ENOEXEC) {         /* for system V NIH syndrome */
            do_execfree();
@@ -1722,7 +1749,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     }
     do_execfree();
     Safefree(buf);
-    return FALSE;
+    return DO_EXEC_RETVAL(result);
 }
 
 #endif /* OS2 || WIN32 */

diff --git a/embed.fnc b/embed.fnc
index 1be276f..8f033df 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -349,9 +349,9 @@ Afrpd   |OP*    |die            |NULLOK const char* pat|...
 pr     |void   |die_unwind     |NN SV* msv
 Ap     |void   |dounwind       |I32 cxix
 : FIXME
-pmb    |bool   |do_aexec       |NULLOK SV* really|NN SV** mark|NN SV** sp
+pmb    |DO_EXEC_TYPE|do_aexec  |NULLOK SV* really|NN SV** mark|NN SV** sp
 : Used in pp_sys.c
-p      |bool   |do_aexec5      |NULLOK SV* really|NN SV** mark|NN SV** sp|int fd|int do_report
+p      |DO_EXEC_TYPE|do_aexec5 |NULLOK SV* really|NN SV** mark|NN SV** sp|int fd|int do_report
 Ap     |int    |do_binmode     |NN PerlIO *fp|int iotype|int mode
 : Used in pp.c
 Ap     |bool   |do_close       |NULLOK GV* gv|bool not_implicit
@@ -359,9 +359,9 @@ Ap  |bool   |do_close       |NULLOK GV* gv|bool not_implicit
 p      |bool   |do_eof         |NN GV* gv
 
 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
-pm     |bool   |do_exec        |NN const char* cmd
+pm     |DO_EXEC_TYPE|do_exec   |NN const char* cmd
 #else
-p      |bool   |do_exec        |NN const char* cmd
+p      |DO_EXEC_TYPE|do_exec   |NN const char* cmd
 #endif
 
 #if defined(WIN32) || defined(__SYMBIAN32__) || defined(VMS)
@@ -370,7 +370,7 @@ Ap  |int    |do_spawn       |NN char* cmd
 Ap     |int    |do_spawn_nowait|NN char* cmd
 #endif
 #if !defined(WIN32)
-p      |bool   |do_exec3       |NN const char *incmd|int fd|int do_report
+p      |DO_EXEC_TYPE|do_exec3  |NN const char *incmd|int fd|int do_report
 #endif
 p      |void   |do_execfree
 #if defined(PERL_IN_DOIO_C)

diff --git a/perl.h b/perl.h
index 8eb625b..9178dfc 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -5399,6 +5399,21 @@ struct tempsym; /* defined in pp_pack.c */
 #  include "win32iop.h"
 #endif
 
+/* DO_EXEC_TYPE is the return type of the do_*exec*() functions.
+ * For UNIXish platforms where the exec functions by definition
+ * return only failure, it can be bool (for success, they do not
+ * return).  For other platforms, where the calling entity may
+ * return, the return value may be more complex. */
+#if defined(__amigaos4__)
+#  define DO_EXEC_TYPE I32
+#  define DO_EXEC_FAILURE -1
+#  define DO_EXEC_RETVAL(val) (val)
+#else
+#  define DO_EXEC_TYPE bool
+#  define DO_EXEC_FAILURE FALSE
+#  define DO_EXEC_RETVAL(val) FALSE
+#endif
+
 #include "proto.h"
 
 /* this has structure inits, so it cannot be included before here */

diff --git a/proto.h b/proto.h
index 1ddabd9..0f4e7a0 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -684,10 +684,10 @@ PERL_CALLCONV_NO_RET void Perl_die_unwind(pTHX_ SV* msv)
 #define PERL_ARGS_ASSERT_DIE_UNWIND    \
        assert(msv)
 
-/* PERL_CALLCONV bool  Perl_do_aexec(pTHX_ SV* really, SV** mark, SV** sp); */
+/* PERL_CALLCONV DO_EXEC_TYPE  Perl_do_aexec(pTHX_ SV* really, SV** mark, SV** sp); */
 #define PERL_ARGS_ASSERT_DO_AEXEC      \
        assert(mark); assert(sp)
-PERL_CALLCONV bool     Perl_do_aexec5(pTHX_ SV* really, SV** mark, SV** sp, int fd, int do_report);
+PERL_CALLCONV DO_EXEC_TYPE     Perl_do_aexec5(pTHX_ SV* really, SV** mark, SV** sp, int fd, int do_report);
 #define PERL_ARGS_ASSERT_DO_AEXEC5     \
        assert(mark); assert(sp)
 PERL_CALLCONV int      Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode);
@@ -3588,7 +3588,7 @@ PERL_CALLCONV Signal_t    Perl_sighandler(int sig);
 PERL_CALLCONV void     Perl_sv_nounlocking(pTHX_ SV *sv);
 #endif
 #if !(defined(PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION))
-PERL_CALLCONV bool     Perl_do_exec(pTHX_ const char* cmd);
+PERL_CALLCONV DO_EXEC_TYPE     Perl_do_exec(pTHX_ const char* cmd);
 #define PERL_ARGS_ASSERT_DO_EXEC       \
        assert(cmd)
 #endif
@@ -3747,7 +3747,7 @@ STATIC NV S_mulexp10(NV value, I32 exponent);
 #  endif
 #endif
 #if !defined(WIN32)
-PERL_CALLCONV bool     Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report);
+PERL_CALLCONV DO_EXEC_TYPE     Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report);
 #define PERL_ARGS_ASSERT_DO_EXEC3      \
        assert(incmd)
 #endif
@@ -3948,7 +3948,7 @@ PERL_CALLCONV PADOFFSET   Perl_op_refcnt_dec(pTHX_ OP *o);
 PERL_CALLCONV OP *     Perl_op_refcnt_inc(pTHX_ OP *o);
 #endif
 #if defined(PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION)
-/* PERL_CALLCONV bool  Perl_do_exec(pTHX_ const char* cmd); */
+/* PERL_CALLCONV DO_EXEC_TYPE  Perl_do_exec(pTHX_ const char* cmd); */
 #endif
 #if defined(PERL_DONT_CREATE_GVSV)
 /* PERL_CALLCONV GV*   Perl_gv_SVadd(pTHX_ GV *gv); */